bonjour
j'ai un petit problème d’incohérence sur une macro envoie email
j'ai deux macro la 6 et la 7 qui utilise le même code chaque macro envoie les feuilles spécifiés
la macro 6 fonctionne parfaitement et la 7 bloque sur msg Send "impossible de reconnaître un ou plusieurs nom"
d'ou provient l'erreur je vous met les 2 macro
Sub macro6()
Dim rep As Integer
rep = MsgBox("Voulez-vous envoyer le Reporting PHOTOBOX ?", vbYesNo + vbQuestion, "Envoie Email Photobox")
If rep = vbYes Then
Application.ScreenUpdating = False
répertoireAppli = "C:\Archives photobox\Dossier tempo pour email"
Sheets(Array("Reporting palettes par mois", "Reporting complet")).Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "\Reporting PHOTOBOX du " & _
Format(Worksheets("Reporting palettes par mois").Range("E3"), "d\-mm\-yyyy") & ".xls"
ActiveWindow.Close
'--- Envoi par mail
Dim olapp As Object 'Outlook.Application
Sheets("Envoie Email").Select
Range("B41").Select
Set olapp = CreateObject("Outlook.Application")
Do While Not IsEmpty(ActiveCell)
Dim msg As Object 'MailItem
Set msg = olapp.CreateItem(0)
msg.To = ActiveCell.Value
msg.To = ActiveCell.Value
msg.Subject = Range("B28").Value
msg.CC = Range("b48").Value
msg.Body = Range("B31").Value & Chr(13) & Range("B32").Value & Chr(13) & Range("B33").Value & Chr(13) & Range("B34").Value & Chr(13) & Chr(13) & Range("B35").Value & Chr(13) & Range("B38").Value & Chr(13)
msg.Attachments.Add répertoireAppli & "\Reporting PHOTOBOX du " & _
Format(Worksheets("Reporting palettes par mois").Range("E3"), "d\-mm\-yyyy") & ".xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
Set msg = Nothing
Set olapp = Nothing
Application.ScreenUpdating = True
MsgBox "le Reporting PHOTOBOX a été envoyé par email avec succés ...."
Else
End If
End Sub
Sub macro7()
Dim rep As Integer
rep = MsgBox("Voulez-vous envoyer l'email ?", vbYesNo + vbQuestion, "Envoie Email Photobox")
If rep = vbYes Then
répertoireAppli = "C:\Archives photobox\Dossier tempo pour email"
Sheets(Array("A compléter", "Récap info CMR", "cmr DPD", "cmr royal mail ")).Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "\Consolidation des UK Arvato&Sartrouville du " & _
Format(Worksheets("A compléter").Range("c2"), "d\-mm\-yyyy") & ".xls"
ActiveWindow.Close
'--- Envoi par mail
Dim olapp As Object 'Outlook.Application
Sheets("Envoie Email").Select
Range("B87").Select
Set olapp = CreateObject("Outlook.Application")
Do While Not IsEmpty(ActiveCell)
Dim msg As Object 'MailItem
Set msg = olapp.CreateItem(0)
msg.To = ActiveCell.Value
msg.Subject = Range("B74").Value
msg.CC = Range("b93").Value
msg.Body = Range("B77").Value & Chr(13) & Chr(13) & Range("B78").Value & Chr(13) & Chr(13) & Range("B79").Value & Chr(13) & Chr(13) & Range("B80").Value & Chr(13) & Chr(13) & Range("A81").Value & Chr(13) & Chr(13) & Range("B84").Value & Chr(13) & Chr(13)
msg.Attachments.Add répertoireAppli & "\Consolidation des UK Arvato&Sartrouville du " & _
Format(Worksheets("A compléter").Range("c2"), "d\-mm\-yyyy") & ".xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
Set msg = Nothing
Set olapp = Nothing
MsgBox "La Consolidation des UK Arvato&Sartrouville a été envoyé par email avec succés ...."
Else
End If
End Sub
une idée du probleme
Julie
j'ai un petit problème d’incohérence sur une macro envoie email
j'ai deux macro la 6 et la 7 qui utilise le même code chaque macro envoie les feuilles spécifiés
la macro 6 fonctionne parfaitement et la 7 bloque sur msg Send "impossible de reconnaître un ou plusieurs nom"
d'ou provient l'erreur je vous met les 2 macro
Sub macro6()
Dim rep As Integer
rep = MsgBox("Voulez-vous envoyer le Reporting PHOTOBOX ?", vbYesNo + vbQuestion, "Envoie Email Photobox")
If rep = vbYes Then
Application.ScreenUpdating = False
répertoireAppli = "C:\Archives photobox\Dossier tempo pour email"
Sheets(Array("Reporting palettes par mois", "Reporting complet")).Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "\Reporting PHOTOBOX du " & _
Format(Worksheets("Reporting palettes par mois").Range("E3"), "d\-mm\-yyyy") & ".xls"
ActiveWindow.Close
'--- Envoi par mail
Dim olapp As Object 'Outlook.Application
Sheets("Envoie Email").Select
Range("B41").Select
Set olapp = CreateObject("Outlook.Application")
Do While Not IsEmpty(ActiveCell)
Dim msg As Object 'MailItem
Set msg = olapp.CreateItem(0)
msg.To = ActiveCell.Value
msg.To = ActiveCell.Value
msg.Subject = Range("B28").Value
msg.CC = Range("b48").Value
msg.Body = Range("B31").Value & Chr(13) & Range("B32").Value & Chr(13) & Range("B33").Value & Chr(13) & Range("B34").Value & Chr(13) & Chr(13) & Range("B35").Value & Chr(13) & Range("B38").Value & Chr(13)
msg.Attachments.Add répertoireAppli & "\Reporting PHOTOBOX du " & _
Format(Worksheets("Reporting palettes par mois").Range("E3"), "d\-mm\-yyyy") & ".xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
Set msg = Nothing
Set olapp = Nothing
Application.ScreenUpdating = True
MsgBox "le Reporting PHOTOBOX a été envoyé par email avec succés ...."
Else
End If
End Sub
Sub macro7()
Dim rep As Integer
rep = MsgBox("Voulez-vous envoyer l'email ?", vbYesNo + vbQuestion, "Envoie Email Photobox")
If rep = vbYes Then
répertoireAppli = "C:\Archives photobox\Dossier tempo pour email"
Sheets(Array("A compléter", "Récap info CMR", "cmr DPD", "cmr royal mail ")).Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "\Consolidation des UK Arvato&Sartrouville du " & _
Format(Worksheets("A compléter").Range("c2"), "d\-mm\-yyyy") & ".xls"
ActiveWindow.Close
'--- Envoi par mail
Dim olapp As Object 'Outlook.Application
Sheets("Envoie Email").Select
Range("B87").Select
Set olapp = CreateObject("Outlook.Application")
Do While Not IsEmpty(ActiveCell)
Dim msg As Object 'MailItem
Set msg = olapp.CreateItem(0)
msg.To = ActiveCell.Value
msg.Subject = Range("B74").Value
msg.CC = Range("b93").Value
msg.Body = Range("B77").Value & Chr(13) & Chr(13) & Range("B78").Value & Chr(13) & Chr(13) & Range("B79").Value & Chr(13) & Chr(13) & Range("B80").Value & Chr(13) & Chr(13) & Range("A81").Value & Chr(13) & Chr(13) & Range("B84").Value & Chr(13) & Chr(13)
msg.Attachments.Add répertoireAppli & "\Consolidation des UK Arvato&Sartrouville du " & _
Format(Worksheets("A compléter").Range("c2"), "d\-mm\-yyyy") & ".xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
Set msg = Nothing
Set olapp = Nothing
MsgBox "La Consolidation des UK Arvato&Sartrouville a été envoyé par email avec succés ...."
Else
End If
End Sub
une idée du probleme
Julie