Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…