Hi,
if you have Access 2007, you'll need to install the add-in to publish pdf's, free download at https://www.microsoft.com/downloads/...displaylang=en
This is a piece of the code I use to create the mail with pdf's:
Code:
With rst
If Not (.BOF And .EOF) Then
'get PDF locations
strR = Nz(Me.OpenArgs, "rptClubExamenlijst")
If strR = "rptClubExamenlijst" Then
strS = "Examenlijst " & Format(Date, "dd-mm-yyyy")
ElseIf strR = "rptClubAdminLijst" Then
strS = "Administratieve lijst " & Format(Date, "dd-mm-yyyy")
ElseIf strR = "rptClubFiche" Then
strS = "Clubfiche " & Format(Date, "dd-mm-yyyy")
Else
strS = "Administratie - secretariaat VKF"
End If
objMailing.LoadMailingPars (strR)
.MoveFirst
intC = 0
While Not .EOF
objCurSel.EmptyCurSel
Call objCurSel.InsertCurSel(!wafEntiteitsID, "")
strClubnummer = CStr(Nz(!wafClubNummer, "nn"))
'test: creer een gewoon accass rapport
'DoCmd.OpenReport strR & "_pdf", acViewPreview
'creer de pDF
strFile = objMailing.MailLoc & "\Club" & strClubnummer & strR & Format(Now, "YYYYMMDD_hms") & ".pdf"
DoCmd.OutputTo acOutputReport, strR & "_PDF", acFormatPDF, strFile, False
'if exisyting e-mail adress: create mail
strMailadres = Nz(DLookup("clubEmail", "tblClubs", "clubID = " & Nz(!wafEntiteitsID, 0)))
If Len(strMailadres) > 0 Then
fMailCreated = objMailing.SendMailMessage(strMailadres, strS, objMailing.MailTekst, strFile)
If fMailCreated Then ' creeer een record in tabel mailing
lngMailID = objMailing.CreateMailRecord("C", !wafEntiteitsID, strMailadres, False, strR)
'delete pdf of send mails
fFileDeleted = objMailing.DeleteStoredFile(strFile)
intC = intC + 1
End If
End If
.MoveNext
Wend
MsgBox intC & " E-mails created"
End If
.Close
End With
The objMailing is an object created from the Mailing class I wrote to handle all interactions with Outlook, the createmail function in that class is written as follows:
Code:
Public Function SendMailMessage(strTo As String, strSubject As String, strBody As String, strFile As String) As Boolean
On Error GoTo Err_SendMailMessage
Dim appOutlook As New Outlook.Application
Dim msg As Outlook.MailItem
Dim intpos As Integer
Set msg = appOutlook.CreateItem(olMailItem)
msg.To = strTo
msg.Subject = strSubject
msg.Body = strBody
msg.Attachments.Add (strFile)
SendMessageNow:
msg.Send
SendMailMessage = True
Exit_SendMailMessage:
Exit Function
Err_SendMailMessage:
'MsgBox Err.Number & ": " & Err.Description
If Err.Number = -2147467259 Then 'Outlook doesn't recognize the adress
intpos = InStr(1, strTo, "#")
If intpos > 1 Then
strTo = Left(strTo, intpos - 1)
msg.To = strTo
Resume SendMessageNow
End If
End If
SendMailMessage = False
Resume Exit_SendMailMessage
End Function