nrdz83
XLDnaute Impliqué
Bonjour à tous,
voila j'utilise le code ci dessous pour créerune copie de ma feuille au format PDF dans le dossier ou est rangé mon classeur.
ça fonctionne jusqu'au moment de l'attachement du fichier PDF au message.
J'utilise excel et outlook 2010.
Quelqu'un aurait il une idée pourquoi ça plante?
Par avance je vous remercie
amitiés
voila j'utilise le code ci dessous pour créerune copie de ma feuille au format PDF dans le dossier ou est rangé mon classeur.
ça fonctionne jusqu'au moment de l'attachement du fichier PDF au message.
J'utilise excel et outlook 2010.
Quelqu'un aurait il une idée pourquoi ça plante?
Par avance je vous remercie
amitiés
Code:
Sub envoi_Feuille_appel()
' Avant de lancer cette macro : Dans l'éditeur VBA, faire
' Menu / Outils / Références... /
' et cocher "Microsoft Outlook 11.0 Object Library"
If MsgBox("Êtes vous sur de vouloir envoyer par mail la feuille d'appel du jour au format PDF ?", vbQuestion + vbYesNo, "QUESTION ...") = vbYes Then
Dim répertoireAppli As String, olapp As New Outlook.Application, msg As MailItem, s As String
Application.ScreenUpdating = False
répertoireAppli = ActiveWorkbook.Path
'on cré le fichier PDFdans le même dossier que le fichier source
Sheets("Appel").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ActiveWorkbook.Path & "\" & "Appel du jour secteur soutien.pdf"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Sheets("Destinataires").Activate
Range("A11").Select
Do While Not IsEmpty(ActiveCell)
s = s & ActiveCell.Value & "; "
ActiveCell.Offset(1, 0).Select
Loop
s = Left$(s, Len(s) - 2)
Set msg = olapp.CreateItem(olMailItem) ' Envoi par mail
msg.To = s
msg.Subject = Range("A2").Value
msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("A8").Value & Chr(13) & Chr(13)
'erreur à ce niveau
msg.Attachments.Add répertoireAppli & "Appel du jour secteur soutien.pdf"
msg.Send
End If
MsgBox "La feuille d'appel du jour à bien était envoyée aux destinataires ."
End Sub
Sub lit_messagerie()
Dim olapp As Outlook.Application 'penser à Outils/Références Outlook
Dim olns As Outlook.Namespace
Dim olmf As Outlook.MAPIFolder
Dim obj As Object
Set olapp = New Outlook.Application
Set olns = olapp.GetNamespace("mapi")
Set olmf = olns.GetDefaultFolder(olFolderInbox)
For Each obj In olmf.Items
MsgBox obj.Subject
Next
End Sub