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

[danbibi]

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.

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.

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.

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

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

je ne sais pas coder
merci beaucoup !!

 

[danielco]

Bonjour,

Facile, essaie :

Daniel

 

[danbibi]

je tombe sur cette erreur

 

[danielco]

Normal. Poste le code de TA macro pas son image.

Daniel

 

[danbibi]

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

 

[danielco]

Pas la mienne, la tienne.

Daniel

 

[danbibi]

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]

On ne va pas s'en sortir. La macro fait référence à tableeau en le nommant par son index. Pas moyen de savoir à quoi ça correspond. Mets ton classeur en pièce jointe.

Daniel

 

[danbibi]

voila

 

[danielco]

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

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

 

[danbibi]

merci beaucoup ! cela marche.
dans la continuite de tout cela, comment modifier la macro pour faire la meme chose mais avec 5 pdf ?
merci a vous

 

[danielco]

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

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

 

[danbibi]

et cela marche meme si je veux pas envoyer le tout premier pdf ?

 

[danielco]

Non. Dans ce cas :

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

 

[danbibi]

j'obtiens une erreur ici: