Envoi de Fichier Par Mail

Bricoltou

XLDnaute Occasionnel
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

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:

Discussions similaires

Réponses
2
Affichages
538

Statistiques des forums

Discussions
314 049
Messages
2 105 038
Membres
109 236
dernier inscrit
Loic-Bocart