Bonjour 
je cherche a modifie une macro
avec une demande de confirmation de réception et de lecture email
Sub CopieFeuilleEtEnvoiMail()
Reponse = InputBox("Mot de passe")
If Reponse <> "xblade" Then
Exit Sub
Else
MsgBox ("Merci")
End If
'testé avec XP
Dim Fichier As String
Dim iMsg As Object, iConf As Object, iBP As Object
Const cdoSendUsingPickup = 1
Fichier = "Enregistrement " & Format(Date, "d mmmm yyyy") & " " & Format(Time, "h mm ss") & ".xls"
Application.ScreenUpdating = False
ThisWorkbook.Sheets("Commande").Copy 'creer un nouveau classeur contenant uniquement la feuille cible
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Fichier
' enregistrement nouveau classeur (possibilité d'adapter le chemin et le nom du fichier)
ActiveWorkbook.Close 'fermer le classeur enregistré
'envoi mail
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
With iMsg
Set .Configuration = iConf
.To = "email " 'destinateire
.Subject = "test email " 'sujet
.HTMLBody = "je vous prie de bien vouloir trouver ci-joint notre commande ‹BR›Bonne réception ‹BR› xblade " 'corps du message
'.HTMLBody = "1ere ligne ‹BR›2eme ligne "
Set iBP = iMsg.AddAttachment(ThisWorkbook.Path & "\" & Fichier) 'piece jointe
.Send 'envoi
'l'envoi se fait sans message de confirmation et sans copie dans les elements envoyés
End With
Application.ScreenUpdating = True
End Sub
je cherche a modifie une macro
avec une demande de confirmation de réception et de lecture email
Sub CopieFeuilleEtEnvoiMail()
Reponse = InputBox("Mot de passe")
If Reponse <> "xblade" Then
Exit Sub
Else
MsgBox ("Merci")
End If
'testé avec XP
Dim Fichier As String
Dim iMsg As Object, iConf As Object, iBP As Object
Const cdoSendUsingPickup = 1
Fichier = "Enregistrement " & Format(Date, "d mmmm yyyy") & " " & Format(Time, "h mm ss") & ".xls"
Application.ScreenUpdating = False
ThisWorkbook.Sheets("Commande").Copy 'creer un nouveau classeur contenant uniquement la feuille cible
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Fichier
' enregistrement nouveau classeur (possibilité d'adapter le chemin et le nom du fichier)
ActiveWorkbook.Close 'fermer le classeur enregistré
'envoi mail
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
With iMsg
Set .Configuration = iConf
.To = "email " 'destinateire
.Subject = "test email " 'sujet
.HTMLBody = "je vous prie de bien vouloir trouver ci-joint notre commande ‹BR›Bonne réception ‹BR› xblade " 'corps du message
'.HTMLBody = "1ere ligne ‹BR›2eme ligne "
Set iBP = iMsg.AddAttachment(ThisWorkbook.Path & "\" & Fichier) 'piece jointe
.Send 'envoi
'l'envoi se fait sans message de confirmation et sans copie dans les elements envoyés
End With
Application.ScreenUpdating = True
End Sub
