Microsoft 365 Macro envoi invitation Outlook à partir d'une liste Excel avec ajout de pièce de jointe

thomasTRZ

XLDnaute Nouveau
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.


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.
 

Pièces jointes

  • Invit.xlsm
    22.3 KB · Affichages: 25

fanch55

XLDnaute Barbatruc
Bonjour,
sFichier doit être de type Variant

VB:
Sub Envoi()
Dim sFichier As Variant
   
    sFichier = Application.GetOpenFilename(, , "Sélectionner le fichier à joindre.")
   
    If sFichier <> False Then
        MsgBox "le fichier à envoyer est " & sFichier
    Else
        MsgBox "pas de fichier à envoyer"
    End If

End Sub
 

Pièces jointes

  • Invit-1.xlsm
    18.3 KB · Affichages: 34

Discussions similaires

  • Question
Microsoft 365 Excel VBA
Réponses
14
Affichages
754

Statistiques des forums

Discussions
314 644
Messages
2 111 528
Membres
111 189
dernier inscrit
Laurent.