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
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: