Si le fichier n'existe pas continuer sans que la VBA bug

Bonjour à tous!

Je vous explique en intro mon projet: j'ai crée (en bricolant avec mes connaissances, en recherchant des programmes existant et de temps en temps avec votre aide) un programme capable de séléctionner des lignes ayant des anomalies dans une longues listes, de les trier par identifiant et d'enregistrer un fichier par identifiant, portant le nom de l'identifiant. (si vous le voulez anonymisé je peut vous le fournir). Maintenant, je cherche à envoyer ces fichiers à différents acteurs (Qui sont toujours associé aux mêmes ID). J'ai trouvé ce programme. Là où j'ai besoin de votre aide c'est pour la partie fichier joint. En effet, il peut arriver que le fichier que je veux joindre n'existe pas (aucune anomalie avec cette ID donc aucun fichier crée). dans ce cas j'aimerais que le programme n'envoi pas de mail s'il n'y avait pas d'autres fichiers à joindre ou joind les autres fichiers s'ils sont existants et ne bug pas.

Voici la partie du programme "piéce jointe"

'Piéces jointe

Attachment1 = "C:\Data\*****\*****\****.xls"

Attachment2 = ""

Attachment3 = ""

If Attachment1 <> "" And Attachment2 <> "" And Attachment3 <> "" Then

Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment1")

Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment1, "Attachment1") 'Si erreur ici, surement du au fait que le fichier de attachement1 n'existe pas

MailDoc.CREATERICHTEXTITEM (Attachment1)

Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment2")

Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment2, "Attachment2")

MailDoc.CREATERICHTEXTITEM (Attachment2)

Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment3")

Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment3, "Attachment3")

MailDoc.CREATERICHTEXTITEM (Attachment3)

End If

Et au cas où vous en auriez besoin voici tout le programme concernant l'envoi par fichier:

Sub ********()

'Set up the objects required for Automation into lotus notes

Dim Maildb As Object 'The mail database

Dim UserName As String 'The current users notes name

Dim MailDbName As String 'THe current users notes mail database name

Dim MailDoc As Object 'The mail document itself

Dim AttachME As Object 'The attachment richtextfile object

Dim Session As Object 'The notes session

Dim EmbedObj As Object 'The embedded object (Attachment)

'Start a session to notes

Set Session = CreateObject("Notes.NotesSession")

'Get the sessions username and then calculate the mail file name

'You may or may not need this as for MailDBname with some systems you

'can pass an empty string

UserName = Session.UserName

MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"

'Open the mail database in notes

Set Maildb = Session.GETDATABASE("", MailDbName)

If Maildb.IsOpen = True Then

'Already open for mail

Else

Maildb.OPENMAIL

End If

'Corps du courrier

Set MailDoc = Maildb.CREATEDOCUMENT

MailDoc.Form = "Memo"

MailDoc.Sendto = "***.****@****.com"

MailDoc.CopyTo = ""

MailDoc.Subject = "Essai encore et toujours"

' Construction du corps du message

Set objNotesField = MailDoc.CREATERICHTEXTITEM("Body")

With objNotesField

.AppendText "Bonjour,"

.AddNewLine 2

.AppendText "Ceci est un essai, veuillez m'excuser pour le dérangement." 'rajout des lignes au besoin

.AddNewLine 2

.AppendText "Cordialement,"

.AddNewLine 1

.AppendText "***** ****"

.AddNewLine 3

End With

MailDoc.SaveMessageOnSend = SaveIt

'Piéces jointe

Attachment1 = "C:\*****.xls"

Attachment2 = ""

Attachment3 = ""

If Attachment1 <> "" And Attachment2 <> "" And Attachment3 <> "" Then

Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment1")

Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment1, "Attachment1") 'Si erreur ici, surement du au fait que le fichier de attachement1 n'existe pas

MailDoc.CREATERICHTEXTITEM (Attachment1)

Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment2")

Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment2, "Attachment2")

MailDoc.CREATERICHTEXTITEM (Attachment2)

Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment3")

Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment3, "Attachment3")

MailDoc.CREATERICHTEXTITEM (Attachment3)

End If

'Envoi du mail

MailDoc.PostedDate = Now() 'Mail dans éléments envoyé

MailDoc.Send 0, Recipient

Set Maildb = Nothing

Set MailDoc = Nothing

Set AttachME = Nothing

Set Session = Nothing

Set EmbedObj = Nothing

End Sub

Bonjour à tous,

à la place de ce If , que je ne comprends pas,

If Attachment1 <> "" And .......etc...

on peut utiliser On Error Goto

'*** à supprimer ***If Attachment1 <> "" And Attachment2 <> "" And Attachment3 <> "" Then
On Error GoTo Suite1
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment1")
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment1, "Attachment1") 'Si erreur ici, surement du au fait que le fichier de attachement1 n'existe pas
MailDoc.CREATERICHTEXTITEM (Attachment1)
Suite1:
On Error GoTo Suite2
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment2")
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment2, "Attachment2")
MailDoc.CREATERICHTEXTITEM (Attachment2)
Suite2:
On Error GoTo Suite3
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment3")
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment3, "Attachment3")
MailDoc.CREATERICHTEXTITEM (Attachment3)
'*** à supprimer ***End If
'Envoi du mail
MailDoc.PostedDate = Now() 'Mail dans éléments envoyé
MailDoc.Send 0, Recipient

Suite3:
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
End Sub

à tester

Amicalement

Claude

Il me marque alors "erreur 7224" mais je vais tenter en laissant les if, ce qui le perturbe c'est que je n'envoi à aucun chemin, je tente et reviens.

Je ne bugs plus! En rajoutant ton code avec les if tout va bien!

Merci pour ton aide!

Bonjour,

alors tout va bien