Rapport automatisch verzenden als pdf naar mailadres

Public Function SendInvoice()

Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim fso As FileSystemObject
Dim strRptName As String



Set fso = New FileSystemObject
strRptName = "DigitaleFactuur"


Set MyOutlook = New Outlook.Application

Set db = CurrentDb()

Set MailList = db.OpenRecordset("DigitaalFactureren")




Do Until MailList.EOF

' Here we open the report with Invoicenumber of the maillist
' Afther that we save it in our Invoice folder
DoCmd.OpenReport "DigitaleFactuur", acViewPreview, , "Factuurnummer = " & MailList!Factuurnummer
DoCmd.OutputTo acOutputReport, strDocName, acFormatPDF, "O:\backup\AJ de Lange\Jaaroverzichten\DigitaleFacturen\" & MailList!Factuurnummer & ".pdf"

'We check if there is a mailadres for Invoices when yes then send when no then print out
If Len(MailList("Factuurmailadres") & vbNullString) = 0 Then
  DoCmd.OpenReport "DigitaleFactuur", , , "Factuurnummer = " & MailList!Factuurnummer
Else

'We're going to prepair the mail
Set MyMail = MyOutlook.CreateItemFromTemplate("C:\Users\Gebruiker\AppData\Roaming\Microsoft\Templates\Digitale factuur.oft")
' This addresses it

MyMail.To = MailList("Factuurmailadres")
MyMail.BCC = MailList("Webadres")

'This gives it a subject
MyMail.Subject = "Factuur " & MailList!Ordermaand & " Boomkwekerij de Lange"


'Here we attach the invoice to the mailadress
MyMail.Attachments.Add "O:\backup\AJ de Lange\Jaaroverzichten\DigitaleFacturen\" & MailList!Factuurnummer & ".pdf", olByValue, 1, "My Displayname"


' "My Displayname" = If you don??t want the attachment??s icon string to be "c:myfile.txt" you
' can use this property to change it to something useful, i.e. "4th Qtr Report"

'This display it ready to send, i like to check if invoice is wright!

MyMail.Display

End If
DoCmd.Close acReport, strRptName, acSaveNo

'And on to the next one...
MailList.MoveNext

Loop

'Cleanup after ourselves

Set MyMail = Nothing

'Uncomment the next line if you want Outlook to shut down when its done.
'Otherwise, it will stay running.

'MyOutlook.Quit
Set MyOutlook = Nothing

MailList.Close
Set MailList = Nothing
db.Close
Set db = Nothing

End Function