Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VBA Access Discussion :

Fichiers .dat envoyés avec CDO


Sujet :

VBA Access

  1. #1
    Membre du Club
    Fichiers .dat envoyés avec CDO
    Bonsoir à tous

    J'utiliser le module CDO qui fonctionne parfaitement pour envoyer des emails, y compris avec des pièces jointes, soit en direct, soit via un test sur la présence de variables non-vides.


    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    ' ====================================================
    ' Envoi du mail
    ' ===================================================
     
            .Subject = "Devis N° " & C & " Suite à votre demande"
            .From = "philippe.e@toto.com"
            .To = A
            .BCC = "philippe.e@toto.pro"
            .HTMLBody = Replace(ZZ, Chr(10), "<br>")
            .MDNRequested = True
            .AddAttachment "D:\Temp\Devis " & C & ".pdf"
     
            If IsNull(PJ1) = False Then
            .AddAttachment PJ1
            End If
            DoEvents
     
            If IsNull(PJ2) = False Then
            .AddAttachment PJ2
            End If
            DoEvents
     
            .Send



    Mon interrogation concerne la réception des emails qui comporte systématiquement des fichiers .dat, ce qui n'est pas propre ..



    Existe-t-il une astuce pour éviter le réception de ces fichiers parasites ?

    Merci d'avance

  2. #2
    Rédacteur/Modérateur

    Bonjour,

    C'est la première fois que je vois ce type de comportement avec CDO pourtant je l'utilise partout.

    Il faudrait avant le .send que tu regardes ta collection Attachment pour voir si c'est avant l'envoi ou bien si c'est ajouté après ton envoi.

    Il y a quoi dans ces fichiers ?

    Cordialement,
    Détecter les modifications formulaire Cloud storage et ACCESS
    Classe MELA(CRUD) Opérateur IN et zone de liste Opérateur LIKE
    Visitez mon Blog
    Les questions techniques par MP ne sont pas lues et je ne pratique pas la bactériomancie

  3. #3
    Membre du Club
    Bonjour loufab, et merci de ton aide.

    je génère des documents pdf, édités depuis des états ou déjà existants, mais les .dat sont vides, à 0 octets

    Moi aussi j'utilise sans réserve CDO et à la réflexion, c'est uniquement depuis ce formulaire que cela se produit.

    Je gratte ce que tu viens d'écrire et reviens.

    Merci bon début de WE

  4. ###raw>post.musername###
    Membre du Club
    Je viens peut-être de trouver quelque chose.

    l'envoi des PJ est conditionné par le choix et la validation de l'utilisation.

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    ' ====================================================
    ' Propose 1 à 3 PJ
    ' ====================================================
     
    If MsgBox("Joindre un premier document au devis (1/3) ?", vbYesNo, ">> GERER PIECES A JOINDRE AU DEVIS :") = vbYes Then
    PJ1 = OuvrirUnFichier(Application.hWndAccessApp, "Pointez un Fichier de votre choix", 1, "", "", "\\tsclient\D\Bureau")
    Else: GoTo Suite:
    End If
     
    If MsgBox("Joindre un second document au devis (2/3) ?", vbYesNo, ">> GERER PIECES A JOINDRE AU DEVIS :") = vbYes Then
    PJ2 = OuvrirUnFichier(Application.hWndAccessApp, "Pointez un Fichier de votre choix", 1, "", "", "\\tsclient\D\Bureau")
    Else: GoTo Suite:
    End If
     
    If MsgBox("Enfin, joindre un dernier document au devis (3/3) ?", vbYesNo, ">> GERER PIECES A JOINDRE AU DEVIS :") = vbYes Then
    PJ3 = OuvrirUnFichier(Application.hWndAccessApp, "Pointez un Fichier de votre choix", 1, "", "", "\\tsclient\D\Bureau")
    Else: GoTo Suite:
    End If


    Si l'utilisateur ne choisi pas de PJ, les variables PJ1 à PJ3 restent vides. Je teste quand même leur existence au moment de l'envoi:

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    ' ====================================================
    ' Envoi du mail
    ' ===================================================
     
            .Subject = "Devis N° " & C & " Suite à votre demande"
            .From = "philippe.e@toto.com"
            .To = A
            .BCC = "philippe.e@toto.pro"
            .HTMLBody = Replace(ZZ, Chr(10), "<br>")
            .MDNRequested = True
            .AddAttachment "D:\Gescom\Temp\Devis " & C & ".pdf"     'Génération et envoi du devis
            .AddAttachment "D:\Gescom\Ressources\CGV.pdf"            ' Envoi des CGV stockées sur le serveur
     
            If IsNull(PJ1) = False Then
            .AddAttachment PJ1
            End If
            DoEvents
     
            If IsNull(PJ2) = False Then
            .AddAttachment PJ2
            End If
            DoEvents
     
            If IsNull(PJ3) = False Then
            .AddAttachment PJ3
            End If
            DoEvents



    Je viens d'essayer en attachant toutes mes pièces jointes, et je n'ai plus de fichiers .dat. Ces fichiers semblent donc apparaître lorsque la variable PJx reste vide. Il faudrait que je gère cette partie autrement, mais je ne sais pas qu'elle autre piste tester car je n'envoie ces PJ que si elles existent déjà ....

    Merci
      0  0

  5. ###raw>post.musername###
    Membre du Club
    je viens de rajouter la condition PJx="" dans un else pour être sur qu'il n'y ai rien dans cette variable, mais le .dat est quand même dans le message ...

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    ' ====================================================
    ' Propose 1 à 3 PJ
    ' ====================================================
     
    If MsgBox("Joindre un premier document au devis (1/3) ?", vbYesNo, ">> GERER PIECES A JOINDRE AU DEVIS :") = vbYes Then
    PJ1 = OuvrirUnFichier(Application.hWndAccessApp, "Pointez un Fichier de votre choix", 1, "", "", "\\tsclient\D\Bureau")
    Else:
    PJ1 = ""
    GoTo Suite:
    End If
     
    ' idem pour les autres variables PJ2 et PJ3


    Bref, je ne vois pas ....
      0  0

  6. #6
    Membre expert
    Salut
    N'y aurait-il pas un objet formaté en texte enrichi quelque part ?

  7. ###raw>post.musername###
    Membre du Club
    Citation Envoyé par hyperion13 Voir le message
    Salut
    N'y aurait-il pas un objet formaté en texte enrichi quelque part ?
    Bonjour et Merci Hyperion13

    Le contenu du mail est en html mais c'est détaché des .AddAttachment ...

    Mais voici la totalité du code ... si tu as la gentillesse d'y jeter un oeil ....

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    Private Sub Commande429_Click()
     
    ''''''''''''''''''''''''''''''''
    ' ENVOI devis par EMAIL VIA CDO
    ''''''''''''''''''''''''''''''''
     
     
    ' ====================================================
    ' Déclaration des Variables
    ' ====================================================
     
    Dim A, B, C, D, e, F, W, Z, N As String
    Dim G, h, I As Currency
    Dim AA, AB, AC, AD, AE, af, AG, ZA, ZZ As String
    Dim PJ1, PJ2, PJ3, PJ4, PJ5 As String ' Variables des PJ
     
     
    A = Forms!PROPOSITIONS!FAXGES
    B = Forms!PROPOSITIONS!NOMECOUR
    C = Forms!PROPOSITIONS!DEVIS
    D = Forms!PROPOSITIONS!REMARQ2
    'N = Forms!PROPOSITIONS!NOM
     
    Z = Forms!PROPOSITIONS!SOCI
     
    ' ====================================================
    ' Verif présence email
    ' Si sortie du msg box, on supprime le fichier créé
    ' ====================================================
     
    If IsNull(A) = True Then
    MsgBox ("Impossible d'envoyer le Mail car l'adresse email n'est pas renseignée dans le champ correspondant" & Chr(13) & Chr(13) & "Veuillez corriger et recommencer")
    'Kill ("D:\Gescom\Temp\Devis Auto.pdf")
    Exit Sub
    End If
     
    ' ====================================================
    imprim
    DoCmd.OpenReport "Devis Auto"
    ' ====================================================
    ' Pour être certain que le fichier est créé
    ' ====================================================
    Do While DIR("D:\Gescom\Temp\Devis Auto.pdf") = ""
    DoEvents
    Loop
     
     
    ' ====================================================
    ' Propose 1 à 3 PJ
    ' ====================================================
     
    If MsgBox("Joindre un premier document au devis (1/3) ?", vbYesNo, ">> GERER PIECES A JOINDRE AU DEVIS :") = vbYes Then
    PJ1 = OuvrirUnFichier(Application.hWndAccessApp, "Pointez un Fichier de votre choix", 1, "", "", "\\tsclient\D\Bureau")
    Else:
    PJ1 = ""
    GoTo Suite:
    End If
     
    If MsgBox("Joindre un second document au devis (2/3) ?", vbYesNo, ">> GERER PIECES A JOINDRE AU DEVIS :") = vbYes Then
    PJ2 = OuvrirUnFichier(Application.hWndAccessApp, "Pointez un Fichier de votre choix", 1, "", "", "\\tsclient\D\Bureau")
    Else:
    PJ2 = ""
    GoTo Suite:
    End If
     
    If MsgBox("Enfin, joindre un dernier document au devis (3/3) ?", vbYesNo, ">> GERER PIECES A JOINDRE AU DEVIS :") = vbYes Then
    PJ3 = OuvrirUnFichier(Application.hWndAccessApp, "Pointez un Fichier de votre choix", 1, "", "", "\\tsclient\D\Bureau")
    Else:
    PJ3 = ""
    GoTo Suite:
    End If
     
     
    Suite:
     
    If MsgBox("Voulez-vous joindre la proposition de location ?", vbYesNo, ">> PROPOSER LA SOLUTION DE LOCATION-VENTE :") = vbYes Then
    DoEvents
    DoEvents
    DoEvents
    'imprim
    DoCmd.OpenReport "ET LA LOCATION"
    DoEvents
    DoEvents
    Do While DIR("D:\Gescom\Temp\ET LA LOCATION.pdf") = ""
    DoEvents
    Loop
    PJ4 = "D:\GESCOM\Temp\ET LA LOCATION.pdf"
    Else:
    PJ4 = ""
    End If
     
    ' ======================================================
    If MsgBox("Voulez-vous joindre le PdF de Promotion ?", vbYesNo, ">> GERER LA PROMOTION :") = vbYes Then
    PJ5 = "D:\GESCOM\\Ressources\Promotion.pdf"
    Else:
    PJ5 = ""
    End If
     
    ' ====================================================
    ' COnfirmer l'envoi ou Supprime le fichier créé
    ' ====================================================
    If MsgBox("Envoyer le devis à " & Z & " ?", vbYesNo, ">> CONFIRMATION AVANT ENVOI DU DEVIS :") = vbNo Then
    'Kill ("D:\Gescom\Temp\Devis Auto.pdf")
    GoTo fin:
    'Exit Sub
    End If
     
    ' ====================================================
    ' Génére le fichier avec le chrono dans le nom
    ' ====================================================
     
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FSO.CopyFile "D:\Gescom\Temp\Devis AMPF Auto.pdf", "D:\Gescom\Temp\Devis " & C & ".pdf", True
    DoEvents
    Set FSO = Nothing
    DoEvents
    DoEvents
    ' ====================================================
    ' Génère le corps du mail
    ' ====================================================
     
    AA = "Bonjour " & B & " et merci pour votre demande<br/><br/>Vous trouverez notre offre de prix en pièce jointe. Les documentations techniques sont jointes, à télécharger ci-dessous ou disponibles depuis notre site web :<br/><br/>"
    AB = IIf(D <> "", D, W) & "<br/>"
    AC = "<br/>N'hésitez pas à me contacter pour tout complément d'information. Mon poste direct est le xx xx xx xx.<br/><br/>"
    AG = "Cordiales salutations.<br/><br/>Philippe xxxxx<br/>"
    ZZ = "<FONT COLOR=#000000><FONT FACE=Arial, serif><FONT SIZE=2>" & AA & AB & AC & AD & AE & af & AG & "<br><br><img src=http://image.noelshack.com/fichiers/2019/34/5/137-signature.png>
     
     
    On Error GoTo Error_send
        Dim oCdo As Object
     
        Set oCdo = CreateObject("CDO.Message")
        With oCdo
            With .Configuration.Fields
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "serveur SMTP"
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = "25" 'port utilisé
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxx"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxx"
    .Update
     
            End With
     
    ' ====================================================
    ' Envoi du mail
    ' ===================================================
     
            .Subject = "Devis N° " & C & " Suite à votre demande"
            .From = "philippe.e@ampliconfrance.com"
            .To = A
            .BCC = "philippe.e@ampf.pro"
            .HTMLBody = Replace(ZZ, Chr(10), "<br>")
            .MDNRequested = True
            .AddAttachment "D:\Gescom\Temp\Devis " & C & ".pdf"
            .AddAttachment "D:\GESCOM\Ressources\CGVpdf"
     
            If IsNull(PJ1) = False Then
            .AddAttachment PJ1
            End If
            DoEvents
     
            If IsNull(PJ2) = False Then
            .AddAttachment PJ2
            End If
            DoEvents
     
            If IsNull(PJ3) = False Then
            .AddAttachment PJ3
            End If
            DoEvents
     
            If IsNull(PJ4) = False Then
            .AddAttachment PJ4
            End If
            DoEvents
     
            If IsNull(PJ5) = False Then
            .AddAttachment PJ5
            End If
            DoEvents
     
            .Send
     DoEvents
     
        End With
     
     MsgBox "Devis N° " & C & " envoyé à " & Z
     
    ' ====================================================
    ' Sortie de CDO + Suppression des Pdf créés
    ' ====================================================
     
    fin:
        Set oCdo = Nothing
     
        If "D:\Gescom\Temp\Devis " & C & ".pdf" <> "" Then
        Kill ("D:\Gescom\Temp\Devis " & C & ".pdf")
        DoEvents
        End If
     
     
        If "D:\Gescom\Temp\Devis AMPF Auto.pdf" <> "" Then
        Kill ("D:\Gescom\Temp\Devis AMPF Auto.pdf")
        DoEvents
        End If
     
     
    If "D:\GESCOM\Temp\ET LA LOCATION.pdf" <> "" Then
     
    Do
    DoEvents
    Loop Until DIR("D:\GESCOM\Temp\ET LA LOCATION.pdf") <> ""
    Kill ("D:\GESCOM\Temp\ET LA LOCATION.pdf")
    Do
    DoEvents
    Loop Until DIR("D:\GESCOM\Temp\ET LA LOCATION.pdf") = ""
    DoEvents
    End If
     
    Dim ZAR1 As String
    ZAR1 = "O"
    Form!Envoi = ZAR1
    ZAR1 = ""
     
     'MsgBox "STEP3"
     
        Exit Sub
     
    ' ====================================================
    ' Affichage erreur pour Débug
    ' ====================================================
     
    Error_send:
        MsgBox "Erreur d'envoi " & Err.Number & "  " & Err.Description
        Resume fin
     
    End Sub
      0  0

  8. ###raw>post.musername###
    Rédacteur/Modérateur
    Bonjour,

    Au sujet du code il y a plusieurs choses qui peuvent être sources de problèmes.

    La déclaration

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    Dim A, B, C, D, e, F, W, Z, N As String
    Dim G, h, I As Currency
    Dim AA, AB, AC, AD, AE, af, AG, ZA, ZZ As String
    Dim PJ1, PJ2, PJ3, PJ4, PJ5 As String ' Variables des PJ


    Cette syntaxe est un faux-ami. Ici toutes tes variables sont Variant sauf N ZZ et PJ5 qui sont String et I qui est Currency. J'image que ce n'est pas ce que tu as voulu faire. En VBA il faut typer explicitement chacune des déclarations.

    Comme ceci par exemple :
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    Dim PJ1 As String, PJ2 As String, PJ3 As String, PJ4 As String, PJ5 As String


    on encore
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    Dim PJ1 As String
    dim PJ2 As String
    dim PJ3 As String
    dim PJ4 As String
    dim PJ5 As String


    Ensuite il y a une autre chose qui m'interpelle c'est les tests que tu fais :

    Ici tu mets PJ1 à vide (string vide)
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    If MsgBox("Joindre un premier document au devis (1/3) ?", vbYesNo, ">> GERER PIECES A JOINDRE AU DEVIS :") = vbYes Then
    PJ1 = OuvrirUnFichier(Application.hWndAccessApp, "Pointez un Fichier de votre choix", 1, "", "", "\\tsclient\D\Bureau")
    Else:
    PJ1 = ""
    GoTo Suite:
    End If


    Puis lors de ton test tu testes si il est Null.

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    If IsNull(PJ1) = False Then
            .AddAttachment PJ1
            End If
            DoEvents


    Null est un valeur totalement différente de "" (string vide).
    Soit tu mets toutes tes variables en Variant et tu pourras utiliser isnull() soit elles sont toutes string et dans ce cas c'est plutôt :
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    if len(PJx)<>0 
    if PJx<>""


    Enfin il faut que tu t'assures bien de ce qui se passe au moment de l'attachment de tes PJ. En mettant des
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    debug.print "attachement de " & isnull(PJx) /ou len(Pjx)
    par exemple.
    Vérifie que OuvreUnfichier renvoi bien un string et en cas d'annulation un "" si tu as mis tes variables PJ en string, si il renvoi un null ça risque de poser problème.

    Je pense que c'est un variant à null que tu attaches.

    Cordialement,
      0  0

  9. #9
    Membre du Club
    Merci loufab

    Je suis plutôt débutant et tes remarques me sont précieuses : j'ai appris plein de truc !

    Je mets mon code au propre en fonction de tes remarques et je vous tiens au jus.

    @+

  10. #10
    Membre du Club
    Bien vu !

    Je pense que c'est un variant à null que tu attaches.
    J'ai déclaré mes variables en string (alors ça ... ... j'ai appris un truc ... tout mon code à vérifier) et modifié mes tests avec
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    if PJx<>""


    Résultat : plus de fichiers parasites envoyé par CDO.

    Vive ce forum et merci à Loufab et vous tous.

    Bon WE

###raw>template_hook.ano_emploi###