Bonjour Le Forum
Avec l'aide de Papou que je remercie encore , j'ai cette Macro qui fonctionne trés bien mais j'ai besoin de savoir si mon destinataire en a bien pris réception .
peux t'on modifier ce code afin de mettre en automatique les options outloock :
Demande un accusé de réception pour ce message
Demande une confirmation de lecture pour ce message
Merci d'avance pour vos conseils
Bricoltou
Avec l'aide de Papou que je remercie encore , j'ai cette Macro qui fonctionne trés bien mais j'ai besoin de savoir si mon destinataire en a bien pris réception .
peux t'on modifier ce code afin de mettre en automatique les options outloock :
Demande un accusé de réception pour ce message
Demande une confirmation de lecture pour ce message
Merci d'avance pour vos conseils
Bricoltou
Code:
Private Sub CommandButton1_Click()
Dim WbkCible As Workbook, adr As String, sujet As String, x As String
Dim nom As String, i%, fichier As String, Ws As Sheets
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
For i = 1 To 9
If Controls("Tbox" & i) = "" Then MsgBox "Vous Devez Impérativement Remplir Tous Les Champs!!", vbExclamation, "Champs pas Rempli": Exit Sub
Next i
Application.ScreenUpdating = False
nom = Recherche_fournisseur.TextBox1 & " - " & Confirmation.CbBoxclient
Set WbkCible = Workbooks.Add
sujet = "Commande Express " & Format(Date, "yyyy mm dd") & " " & nom
' fichier = "K:\Affretement\Archive\" & sujet & ".xls"
fichier = "C:\Documents and Settings\Desktop\Camionnage\Affretement\Archive\" & sujet & ".xls"
ActiveWorkbook.SaveAs (sujet)
Application.DisplayAlerts = False
For i = Sheets.Count To 1 Step -1
If Sheets(i).Name <> "Feuil1" Then Sheets(i).Delete
Next i
Application.DisplayAlerts = True
ActiveSheet.Paste
Confirmation.Hide
Recherche_fournisseur.Hide
x = ActiveWorkbook.FullName
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.196850393700787)
.RightMargin = Application.InchesToPoints(0.196850393700787)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0.118110236220472)
.FooterMargin = Application.InchesToPoints(0.196850393700787)
.Orientation = xlLandscape
.CenterHorizontally = True
.CenterVertically = True
End With
ActiveWorkbook.SaveCopyAs (fichier)
adr = Recherche_fournisseur.TextBox9
ActiveWorkbook.SendMail adr, sujet
ActiveWorkbook.Close savechanges:=False
On Error Resume Next
Kill x
End Sub
Dernière édition: