Erreur dans boucle

Le 09/01/2019 à 16:05

Bonjour à tous,

c'est ma 1ère fois sur le forum et je bloque dans mon code VBA.

J'ai un fichier Excel avec des adresses mails pour X fournisseurs (fichier A) et j'ai Y fichiers Excel (B) à envoyer à des fournisseurs du fichier A (j'ai plus de fournisseurs que de fichiers Excel car certains fournisseurs ne sont tout simplement pas concernés pour ce trimestre).

J'ai créé un code qui va chercher le fichier Excel (B) qui se rattache au fournisseur et à un numéro de contrat (grâce à son intitulé qui comporte ces informations). Maintenant, je veux envoyer ce fichier Excel à l'adresse mail rattachée à ce fournisseur (indiquée dans le fichier A) et faire une boucle sur tous les fournisseurs.

Pour tous ceux qui ont un fichier les concernant, leur envoyer, pour le reste ne rien faire.

Or voilà où je suis perdue. Je souhaite que dans ma boucle, lorsque le fournisseur et son contrat ne matchent aucun fichier Excel (B), on passe au suivant jusqu'à ce qu'on trouve un fichier qui match et serait à envoyer et ainsi de suite.

J'espère être assez claire, voici mon code pour l'instant, le problème étant que lorsqu'aucun fichier Excel ne match un fournisseur, il envoie le fichier sur lequel je traite mon code (A) car c'est le fichier actif or c'est ce que je ne veux pas :

Sub Envoyer_Mail_Outlook()

Dim ObjOutlook As New Outlook.Application

Dim oBjMail, RP

Dim Wb As Workbook

Dim myItem As Outlook.MailItem

Dim myAttachments As Outlook.Attachments

Dim Varcellvalue As String

Set myApp = CreateObject("Outlook.Application")

Set myItem = myApp.CreateItem(olMailItem)

Set myAttachments = myItem.Attachments

For i = 3 To 15

Varcellvalue = Range("B" & i) & " - " & Range("C" & i)

Workbooks.Open ("C:\Users\XX\XX\XXX\XXXX\XX -" & Varcellvalue & ".xls")

myAttachments.Add (ActiveWorkbook.FullName)

ThisWorkbook.Activate

myItem.Subject = Range("B" & i) & " - " & Range("C" & i)

myItem.Body = Range("B" & i) & " - " & Range("C" & i)

myItem.To = Range("I" & i)

myItem.Send

Set oBjMail = Nothing

Set ObjOutlook = Nothing

Next i

End Sub

Merci beaucoup pour votre aide !

Le 09/01/2019 à 16:18

Bonjour,

Je débute en VBA donc je ne suis pas sur du tout mais il faudrait pas que tu ajoutes une condition "Si" du genre "Si le fichier match avec le fournisseur, alors tu envoies, sinon tu passes au suivant" ?

Le 09/01/2019 à 16:20

bonjour,

une proposition de correction (non testée)

Sub Envoyer_Mail_Outlook()

Dim myapp As Object, myitem As Object, i As Long
Dim varcellvalue As String, nf As String, repertoire As String

    Set myapp = CreateObject("Outlook.Application")

    repertoire = "C:\Users\XX\XX\XXX\XXXX\XX -"
    For i = 3 To 15
        Set myitem = myapp.CreateItem(0) '0 = mailItem
        varcellvalue = Range("B" & i) & " - " & Range("C" & i)
        nf = Dir(repertoire & varcellvalue & ".xls") 'on vérifie si fichier existe
        If nf <> "" Then  'si fichier existe
            With myitem
                .Subject = Range("B" & i) & " - " & Range("C" & i)
                .Body = Range("B" & i) & " - " & Range("C" & i)
                .To = Range("I" & i)
                .attachments.Add repertoire & varcellvalue & ".xls"
                .display
                '.Send enlever ' pour envoi automatique des messages
            End With
        End If
    Next i

End Sub
Le 09/01/2019 à 16:24

Bonjour,

ton soucis c'est que tu ne testes nul part que ton fichier a bien été ouvert, tu peux essayer ce bout de code:

Sub Envoyer_Mail_Outlook()
 Dim Fichier as Workbook
 Dim ObjOutlook As New Outlook.Application
 Dim oBjMail, RP
 Dim Wb As Workbook
 Dim myItem As Outlook.MailItem
 Dim myAttachments As Outlook.Attachments
 Dim Varcellvalue As String

 Set myApp = CreateObject("Outlook.Application")
 Set myItem = myApp.CreateItem(olMailItem)
 Set myAttachments = myItem.Attachments

 For i = 3 To 15

 Varcellvalue = Range("B" & i) & " - " & Range("C" & i)
 set Fichier = Workbooks.Open ("C:\Users\XX\XX\XXX\XXXX\XX -" & Varcellvalue & ".xls")
 if Not Fichier is Nothing then
   Fichier.Activate
   myAttachments.Add (ActiveWorkbook.FullName)
   myItem.Subject = Range("B" & i) & " - " & Range("C" & i)
   myItem.Body = Range("B" & i) & " - " & Range("C" & i)
   myItem.To = Range("I" & i)
   myItem.Send

   Fichier.Close
   Set oBjMail = Nothing
   Set ObjOutlook = Nothing
   Set Fichier = Nothing
  End If
 Next i

 End Sub

Merci de me dire si ça fonctionne

If not fichier is nothing devrait vérifier que le classeur a bien été ouvert, sinon Fichier devra être vide, car je le vide après chaque envoi de mail.

EDIT:

salut h2so4

Le 09/01/2019 à 16:26

Ça fonctionne merci beaucoup !

h2so4 a écrit :

bonjour,

une proposition de correction (non testée)

Sub Envoyer_Mail_Outlook()

Dim myapp As Object, myitem As Object, i As Long
Dim varcellvalue As String, nf As String, repertoire As String

    Set myapp = CreateObject("Outlook.Application")

    repertoire = "C:\Users\XX\XX\XXX\XXXX\XX -"
    For i = 3 To 15
        Set myitem = myapp.CreateItem(0) '0 = mailItem
        varcellvalue = Range("B" & i) & " - " & Range("C" & i)
        nf = Dir(repertoire & varcellvalue & ".xls") 'on vérifie si fichier existe
        If nf <> "" Then  'si fichier existe
            With myitem
                .Subject = Range("B" & i) & " - " & Range("C" & i)
                .Body = Range("B" & i) & " - " & Range("C" & i)
                .To = Range("I" & i)
                .attachments.Add repertoire & varcellvalue & ".xls"
                .display
                '.Send enlever ' pour envoi automatique des messages
            End With
        End If
    Next i

End Sub
Le 09/01/2019 à 16:32
Ausecour a écrit :

Bonjour,

ton soucis c'est que tu ne testes nul part que ton fichier a bien été ouvert, tu peux essayer ce bout de code:

Sub Envoyer_Mail_Outlook()
 Dim Fichier as Workbook
 Dim ObjOutlook As New Outlook.Application
 Dim oBjMail, RP
 Dim Wb As Workbook
 Dim myItem As Outlook.MailItem
 Dim myAttachments As Outlook.Attachments
 Dim Varcellvalue As String

 Set myApp = CreateObject("Outlook.Application")
 Set myItem = myApp.CreateItem(olMailItem)
 Set myAttachments = myItem.Attachments

 For i = 3 To 15

 Varcellvalue = Range("B" & i) & " - " & Range("C" & i)
 set Fichier = Workbooks.Open ("C:\Users\XX\XX\XXX\XXXX\XX -" & Varcellvalue & ".xls")
 if Not Fichier is Nothing then
   Fichier.Activate
   myAttachments.Add (ActiveWorkbook.FullName)
   myItem.Subject = Range("B" & i) & " - " & Range("C" & i)
   myItem.Body = Range("B" & i) & " - " & Range("C" & i)
   myItem.To = Range("I" & i)
   myItem.Send

   Fichier.Close
   Set oBjMail = Nothing
   Set ObjOutlook = Nothing
   Set Fichier = Nothing
  End If
 Next i

 End Sub

Merci de me dire si ça fonctionne

If not fichier is nothing devrait vérifier que le classeur a bien été ouvert, sinon Fichier devra être vide, car je le vide après chaque envoi de mail.

EDIT:

salut h2so4

Bonjour ! Merci beaucoup pour ton aide à priori le code ne fonctionne pas et bug au niveau de la ligne setfichier... (car un fichier n'est pas trouvé) mais la solution de h2so4 fonctionne pour info

Merci encore en tout cas

Le 10/01/2019 à 08:11

Bonjour,

J'aurais peut-être dû mettre un On error resume next avant, c'est pour ça, mais la solution de h2so4 est plus adaptée oui

Bonne continuation et merci de m'avoir fait un retour

Rechercher des sujets similaires à "erreur boucle"