sf-Thibault

Bonjour,

Je n'arrive pas à m'en sortir avec cette marco.
Je dois envoyer un fichier .xls par courriel avec microsoft outlook 2003, mais dans ma macro ci-dessous, le fichier .xls n'est pas en pièce jointe mais le reste fonctionne.

Sub Descriptif_seul()
'
' Descriptif_seul Macro
' Macro enregistrée le 04/01/2008 par sf
'

'Sélection cellule et attribuer la date du jour:
Range("E6").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
'Copier la valeur et enregistrer le classeur:
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
'ActiveWorkbook.Save
'Sélection de la zone à copier:
Range("A1:L200").Select
Selection.Copy
'Ouverture fichier en lecture seule et collage:
Workbooks.Open Filename:="G:\Devis standards\Descriptif2.xls", ReadOnly:= _
True
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'Sélection et copie du N° de descriptif:
Range("H8:L9").Select
Selection.Copy
'Attribution du nom de fichier à la cellule N3 et fusion de:
Range("N3").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
'Récupération du N° de descriptif:
NOPRO = Range("N3")
'Modification du nom du fichier:
DEVISNOPRO = "Projet-" & NOPRO
'Attribution du nom de fichier à la cellule N4:
Range("N4").Value = DEVISNOPRO
'Enrigistrment du fichier:
Chemin = "G:\devis standards\NE_PAS_SUPPRIMER\"
ActiveWorkbook.SaveAs Chemin & ActiveSheet.Range("N4").Value


'Ouverture de la boîte de dialogue et remplissage des zones:

Dim OutApp As Object
Dim OutMail As Object
Dim strto As String, strcc As String, strbcc As String
Dim strsub As String, strbody As String

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

strto = Range("N2")
strcc = Range("O2")
'strbcc = ActiveCell
strsub = ("Offre de prix " & ActiveSheet.Range("E5"))
strbody = "Bonjour, l'email fonctionne bien" & vbNewLine & vbNewLine & _
"à verify le document Excel en annexe"

With OutMail
.To = strto
.CC = strcc
.BCC = strbcc
.Subject = strsub
.Body = strbody
' .Send
.Display
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%S"
End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

Merci de m'aider, il ne me manque pas grand chose mais cela me bloque.
A bientôt