Microsoft 365 envoie mail par excel si fonction renvoie un url, n'envoie pas si vide

danbibi

XLDnaute Nouveau
bonjour a tous ! j'aimerai envoyer des mails automatiquement via des excel. Les fichiers sont du mon desktop. J'arrive a envoyer des mails grace a une macro seulement si j'insere dans la cellule le lien pdf.
1601884168415.png
Je fais un tableau afin que les lien pdf se creer automatiquement. Je dois envoyer un fichier a tout le monde. Ca pas de probleme, c'est le tableau des pdf1, ca envoie bien.
1601884125181.png

en ce qui concerne le deuxième pdf, parfois je voudrai l'envoyer aux clients, et parfois non, cela grâce a une colonne, ou lorsque la valeur est 1, je voudrais rajouter le pdf 2, et ne pas l'envoyer si la valeur est 0.
1601884286032.png

dans les cellules du pdf2, jai écrit cette fonction ( fonction si, et concatener)( si rajouter_pdf_2 = 0 je voudrais un vide ("")
1601884324980.png

ca marche quand la valeur du pdf2 est 1( ca envoie donc deux fichiers aux client) mais cela ne marche pas quand il doit y avoir qu'un seul pdf( c'est a dire quand la valeur est 0 dans rajouter_pdf_2)
auriez vous un macro qui me permet de corriger cette erreur ?
voici la macro
1601884473250.png

je ne sais pas coder
merci beaucoup !!
 

Pièces jointes

  • 1601884110666.png
    1601884110666.png
    13.8 KB · Affichages: 1
Dernière édition:
Solution
Désolé, j'ai commis une erreur :

VB:
Public Sub Send_Emails2()

    Dim table As ListObject
    Dim OutlookApp As Object
    Dim OutEmail As Object
    Dim r As Long
    
    Set OutlookApp = CreateObject("Outlook.Application")
    
    Set table = ActiveSheet.ListObjects(1)

    For r = 2 To table.Range.Rows.Count
        MsgBox "PDF1 " & table.ListColumns(2).Range(r).Value & vbCrLf & _
               "PDF2 " & table.ListColumns(3).Range(r).Value & vbCrLf & _
               "PDF3 " & table.ListColumns(4).Range(r).Value
        Set OutEmail = OutlookApp.CreateItem(0)
        With OutEmail
            .To = table.ListColumns(1).Range(r).Value
            .Subject = "Yarok Capital"
            .Body = "Bonjour, pouvez-vous confirmer...

danbibi

XLDnaute Nouveau
Sub valo()

Dim olApp As New Outlook.Application
Dim NS As Namespace, GaddressList
Dim m As MailItem, myRow
myRow = InputBox("Enter row number")
If Not IsNumeric(myRow) Then
MsgBox "Please, enter a numeric Value"
Exit Sub
End If
Set olApp = Outlook.Application
Set NS = olApp.GetNamespace("MAPI")
'Set GaddressList = NS.Session.AddressLists("Global Adress List")
Set GaddressList = NS.Session.AddressLists("Messagerie")
Set m = olApp.CreateItem(olMailItem)
With m
.Subject = "Subject"
.Body = Cells(myRow, 2) & Cells(myRow, 3)
For Each Item In GadressList.AddressEntries
If Item.Name = [A2] Then
.Recipients.Add Item.Address
Exit For
End If
Next
'.SendUsingAccount
If .Recipients.Count = 0 Then
MsgBox "recipient" & [A2] & " not found"
Exit Sub
End If
.Display
.Send
End With

End Sub








merci
 

danbibi

XLDnaute Nouveau
Public Sub Send_Emails2()

Dim table As ListObject
Dim OutlookApp As Object
Dim OutEmail As Object
Dim r As Long

Set OutlookApp = CreateObject("Outlook.Application")

Set table = ActiveSheet.ListObjects(1)

For r = 2 To table.Range.Rows.Count
MsgBox "PDF1 " & table.ListColumns(2).Range(r).Value & vbCrLf & _
"PDF2 " & table.ListColumns(3).Range(r).Value & vbCrLf & _
"PDF3 " & table.ListColumns(4).Range(r).Value
Set OutEmail = OutlookApp.CreateItem(0)
With OutEmail
.To = table.ListColumns(1).Range(r).Value
.Subject = "Yarok Capital"
.Body = "Bonjour, pouvez-vous confirmer blabla"
.Attachments.Add table.ListColumns(2).Range(r).Value
If Not IsEmpty(table.ListColumns(3).Range(r).Value) Then .Attachments.Add table.ListColumns(3).Range(r).Value
If Not IsEmpty(table.ListColumns(4).Range(r).Value) Then .Attachments.Add table.ListColumns(4).Range(r).Value
.Send 'or .Display to not send
End With
Next

Set OutlookApp = Nothing

End Sub
 

danielco

XLDnaute Accro
Tu ne dois pas avoir besoin des "0 et des "1". Teste :

VB:
Public Sub Send_Emails2()

    Dim table As ListObject
    Dim OutlookApp As Object
    Dim OutEmail As Object
    Dim r As Long
    
    Set OutlookApp = CreateObject("Outlook.Application")
    
    Set table = ActiveSheet.ListObjects(1)

    For r = 2 To table.Range.Rows.Count
        MsgBox "PDF1 " & table.ListColumns(2).Range(r).Value & vbCrLf & _
               "PDF2 " & table.ListColumns(3).Range(r).Value & vbCrLf & _
               "PDF3 " & table.ListColumns(4).Range(r).Value
        Set OutEmail = OutlookApp.CreateItem(0)
        With OutEmail
            .To = table.ListColumns(1).Range(r).Value
            .Subject = "Yarok Capital"
            .Body = "Bonjour, pouvez-vous confirmer blabla"
            .Attachments.Add table.ListColumns(2).Range(r).Value
            
            If table.ListColumns(3).Range(r).Value <> "" Then .Attachments.Add table.ListColumns(3).Range(r).Value
            If table.ListColumns(4).Range(r).Value <> "" Then .Attachments.Add table.ListColumns(4).Range(r).Value
            .Send 'or .Display to not send
        End With
    Next
    
    Set OutlookApp = Nothing
    
End Sub

Daniel
 

danielco

XLDnaute Accro
Oui. En supposant qu'ils soient en colonne E et F :

VB:
Public Sub Send_Emails2()

    Dim table As ListObject
    Dim OutlookApp As Object
    Dim OutEmail As Object
    Dim r As Long
    
    Set OutlookApp = CreateObject("Outlook.Application")
    
    Set table = ActiveSheet.ListObjects(1)

    For r = 2 To table.Range.Rows.Count
        MsgBox "PDF1 " & table.ListColumns(2).Range(r).Value & vbCrLf & _
               "PDF2 " & table.ListColumns(3).Range(r).Value & vbCrLf & _
               "PDF3 " & table.ListColumns(4).Range(r).Value
        Set OutEmail = OutlookApp.CreateItem(0)
        With OutEmail
            .To = table.ListColumns(1).Range(r).Value
            .Subject = "Yarok Capital"
            .Body = "Bonjour, pouvez-vous confirmer blabla"
            .Attachments.Add table.ListColumns(2).Range(2).Value
            
            If table.ListColumns(3).Range(r).Value <> "" Then .Attachments.Add table.ListColumns(3).Range(r).Value
            If table.ListColumns(4).Range(r).Value <> "" Then .Attachments.Add table.ListColumns(4).Range(r).Value
            If table.ListColumns(5).Range(r).Value <> "" Then .Attachments.Add table.ListColumns(5).Range(r).Value
            If table.ListColumns(6).Range(r).Value <> "" Then .Attachments.Add table.ListColumns(6).Range(r).Value
            .Send 'or .Display to 6not send
        End With
    Next
    
    Set OutlookApp = Nothing
    
End Sub

Daniel
 

danielco

XLDnaute Accro
Non. Dans ce cas :

VB:
Public Sub Send_Emails2()

    Dim table As ListObject
    Dim OutlookApp As Object
    Dim OutEmail As Object
    Dim r As Long
    
    Set OutlookApp = CreateObject("Outlook.Application")
    
    Set table = ActiveSheet.ListObjects(1)

    For r = 2 To table.Range.Rows.Count
        MsgBox "PDF1 " & table.ListColumns(2).Range(r).Value & vbCrLf & _
               "PDF2 " & table.ListColumns(3).Range(r).Value & vbCrLf & _
               "PDF3 " & table.ListColumns(4).Range(r).Value
        Set OutEmail = OutlookApp.CreateItem(0)
        With OutEmail
            .To = table.ListColumns(1).Range(r).Value
            .Subject = "Yarok Capital"
            .Body = "Bonjour, pouvez-vous confirmer blabla"
            For i = 2 To 6
              If table.ListColumns(i).Range(r).Value <> "" Then .Attachments.Add table.ListColumns(i).Range(2).Value
            Next i
            .Send 'or .Display to 6not send
        End With
    Next
    
    Set OutlookApp = Nothing
    
End Sub

Daniel
 

Discussions similaires

Haut Bas