Bonjour à tous,
Je suis en train de créer un fichier pour envoyer des invitations Outlook a partir d'une liste.
Tout fonctionne correctement à l'exception d'un point.
La macro permet de sélectionner une pièce jointe via une boite de dialogue et de la joindre aux différentes personnes.
Cependant, je veux laisser la possibilité de ne pas en joindre et la je bloque.
En effet, le .Attachments.Add sFichier fonctionne si je joint une piece jointe. Mais je ne sais pas comment contourner si je ne joint pas de pièce jointe.
Je met le fichier pour plus de compréhension.
Merci de votre aide.
Bonne journée à tous.
Je suis en train de créer un fichier pour envoyer des invitations Outlook a partir d'une liste.
Tout fonctionne correctement à l'exception d'un point.
La macro permet de sélectionner une pièce jointe via une boite de dialogue et de la joindre aux différentes personnes.
Cependant, je veux laisser la possibilité de ne pas en joindre et la je bloque.
En effet, le .Attachments.Add sFichier fonctionne si je joint une piece jointe. Mais je ne sais pas comment contourner si je ne joint pas de pièce jointe.
Je met le fichier pour plus de compréhension.
VB:
Sub SendMeetingRequest()
Dim objOL
Dim objAppt
Dim lgDerLig As Long
Dim Ligne As Long
Const olAppointmentItem = 1
Const olMeeting = 1
lgDerLig = Range("A65536").End(xlUp).Row
myCheck = MsgBox("Ajout d'une pièce jointe aux invitations ?", vbYesNo)
If myCheck = vbYes Then
' Do this
Dim sFichier As String
sFichier = Application.GetOpenFilename(, , "Sélectionner le fichier à joindre.")
' .Attachments.Add sFichier
Else
' do that
MsgBox ("Pas de pièce jointe ajoutée.")
End If
For Ligne = 3 To lgDerLig
Set objOL = CreateObject("Outlook.Application")
' entree agenda
Set objAppt = objOL.CreateItem(olMeeting)
With objAppt
.Subject = Cells(Ligne, 3)
.Start = Cells(Ligne, 4) & " " & Cells(Ligne, 5)
.End = Cells(Ligne, 6) & " " & Cells(Ligne, 7)
.Location = Cells(Ligne, 9)
.Body = Cells(Ligne, 10)
.BusyStatus = olBusy
.Categories = ""
.ReminderSet = True
.ReminderMinutesBeforeStart = Cells(Ligne, 8)
.ReminderOverrideDefault = True
.ReminderPlaySound = True
.Importance = olImportanceHigh
On Error GoTo 1
.Attachments.Add sFichier
1
.MeetingStatus = olMeeting
'participant facultatif
.OptionalAttendees = ""
'participant obligatoire
.RequiredAttendees = Cells(Ligne, 2)
.Send
End With
Set objAppt = Nothing
Set objOL = Nothing
Next Ligne
MsgBox "Les invitations ont été envoyées !"
End Sub
Merci de votre aide.
Bonne journée à tous.