[AC-2010] Exportation de documents attaches [Résolu]

[ultima67]

Bonjour,

Je gere une BD sur Access 2010 avec une table qui comporte un champ ''attachment'' (ce sont en general des fichiers PDF ou excel). A chaque enregistrement de cette table est attache un ou plusieurs documents.
J ai cree un formulaire a partir d une requete qui doit me servir a envoyer ces documents par email. Lorsque j exporte ce formulaire en PDF je n ai que le logo du document attache qui apparait.
Je souhaiterai que le document attache soit exporte en meme temps que le formulaire et si possible pouvoir cliquer sur le logo et que le document attache s ouvre.
Est ce que quelqu un a une idee?

Merci d avance pour votre aide.
Sylvie

[Philippe JOCHMANS]

Bonjour

Peux-tu détailler car le fait que tu dises Lorsque j exporte ce formulaire en PDF m'inquiète un peu , car tu auras une image et donc non cliquable.

Philippe

[ultima67]

Bonjour,

Le formulaire que j exporte en PDF est en fait une page de garde pour mon document attache. Il faut que je puisse exporter separement le document attache dans son entier et que j envoye les 2 documents dans un email.

J ai trouve un code qui me permet de sauvegarder le document attache sur mon bureau automatiquement et qui cree en parallele un email. Je n ai plus qu a deplacer manuellement le fichier joint ainsi que le PDF dans mon email. C est deja pas mal mais cela serait mieux si tout le processus pouvait etre automatique.

Merci pour vos suggestions.

Voici le code:

Code :

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
Option Compare Database
Option Explicit
 
Private Sub SaveAttachment_Click()
 
Dim db As DAO.Database
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2
 
Set db = CurrentDb
Set rsParent = Me.Recordset
 
rsParent.OpenRecordset
 
Set rsChild = rsParent.Fields("AttachmentTest").Value
 
rsChild.OpenRecordset
rsChild.Fields("FileData").SaveToFile ("c:\")
 
Exit_SaveAttachment:
 
Set rsChild = Nothing
Set rsParent = Nothing
 
End Sub
 
Private Sub SendEmail_Click()
 
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
 
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
 
With objOutlookMsg
 
Set objOutlookRecip = .Recipients.Add("myrecipient")
objOutlookRecip.Type = olTo
 
.Subject = "Test Email Subject"
.Body = "Please find document attached"
 
.Display
 
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
 
End Sub
 
Private Sub SendAttachment_Click()
 
Call SaveAttachment_Click
Call SendEmail_Click
 
End Sub

[ultima67]

Bonjour,

Apres de nombreux tests voici le code que j ai redige. Je ne suis pas sure qu il soit tres orthodoxe mais en tout cas il fonctionne.

Il me permet d envoyer un email avec les destinataires, le sujet et le message pre enregistre et meme avec ma signature electronique issue d'outlook.
A ce message se trouve en pieces jointes automatiquement mon formulaire sauvegarde en PDF et le document attache a mon formulaire.

Je travaille sur Access 2010, Outlook 2007 et Windows XP sp3 en anglais c est pour cela que mes codes sont en anglais. Desole pour cela.

J espere que cela pourra aider d autres debutants comme moi.

Code :

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
 
Option Compare Database
Option Explicit
 
'Cette fonction permet de mettre dans mon email ma signature electronique issue d'outlook
 
Function GetBoiler(ByVal sFile As String) As String
 
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
 
End Function
 
'Cette fonction permet d exporter en PDF mon formulaire
 
Function PrintToPdf(SrcFile As String)
 
Dim DestPath As String
Dim DestFile As String
Dim ShowPdf As Boolean
 
SrcFile = "FormName"
 
DestPath = "PathName"
 
DestFile = "DocumentName"
 
ShowPdf = False
 
    DoCmd.OutputTo acOutputForm, SrcFile, "PDFFormat(*.pdf)", DestPath & DestFile & ".pdf", ShowPdf, "", 0, acExportQualityPrint
 
PrintToPDF_Exit:
 
Exit Function
 
End Function
 
'Cette procedure permet d exporter mon fichier attache
 
Private Sub SaveAttachment_Click()
 
Dim db As DAO.Database
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2
 
Set db = CurrentDb
Set rsParent = Me.Recordset
 
rsParent.OpenRecordset
 
Set rsChild = rsParent.Fields("FieldAttachementName").Value
 
rsChild.OpenRecordset
rsChild.Fields("FileData").SaveToFile ("PathName")
 
Exit_SaveAttachment:
 
Set rsChild = Nothing
Set rsParent = Nothing
 
End Sub
 
'Cette procedure permet de sauvegarder mon formulaire en PDF
 
Private Sub SaveTransmittal_Click()
 
 Dim strSave As String
 
    strSave = "DocumentName.Pdf"
 
  PrintToPdf (strSave)
 
End Sub
 
'Cette procedure me permet de generer mon email. Fonctionne sur Outlook. Non teste sur d autres gestionnaires d email.
 
Private Sub SendEmail_Click()
 
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach1 As String
Dim objOutlookAttach2 As String
Dim strbody As String
Dim SigString As String
Dim Signature As String
 
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
 
strbody = "All," & Chr$(13) & Chr$(13) & _
"Please find attached our submission regarding                  ." & Chr$(13) & Chr$(13) & _
"Please confirm receipt. Thank you." & Chr$(13) & Chr$(13)
 
SigString = "C:\Documents and Settings\" & Environ("username") \Application Data\Microsoft\Signatures\Mysig.txt"
 
   If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If
 
With objOutlookMsg
 
Set objOutlookRecip = .Recipients.Add("recipient")
objOutlookRecip.Type = olTo
 
Set objOutlookRecip = .Recipients.Add("other recipient")
objOutlookRecip.Type = olCC
 
.Subject = "Our Submission"
.Body = strbody & Signature
 
objOutlookAttach1 = "PathName"
objOutlookAttach2 = "PathName"
 
If Len(objOutlookAttach1) <> 0 Then
objOutlookMsg.Attachments.Add (objOutlookAttach1)
 
If Len(objOutlookAttach2) <> 0 Then
objOutlookMsg.Attachments.Add (objOutlookAttach2)
 
.Display
 
End If
End If
End With
 
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
 
End Sub
 
'Cette procedure est liee a un ''click event'' sur un bouton sur mon formulaire.
 
Private Sub SentAttachment_Click()
 
Call SaveAttachment_Click
Call SaveTransmittal_Click
Call SendEmail_Click
 
Kill ("PathName1stAttachment")
Kill ("PathName2ndAttachment")
 
End Sub

Cordialement.
Sylvie