Emailen mbv VBA
Mbv VBA wil ik vanuit Business Objects per organisatorische eenheid een formatieoverzicht opslaan als PDF bestand, vervolgens wil ik deze bestanden mailen naar het mailadres dat bij de organisatorische eenheid hoort. In onze database is een veld opgenomen waar de mailadressen per organisatorische eenheid staan vermeld.
Het opslaan van de PDF bestanden per organisatorische eenheid gaat prima, helaas krijg ik het nog niet voor elkaar om een mail te sturen met het bestand dat toebehoort aan het mailadres zoals aangegeven in onze database.
Wie kan mij helpen?
Onderstaand hetgeen ik al geprobeerd heb en werkt muv het mailen:
Mbv VBA wil ik vanuit Business Objects per organisatorische eenheid een formatieoverzicht opslaan als PDF bestand, vervolgens wil ik deze bestanden mailen naar het mailadres dat bij de organisatorische eenheid hoort. In onze database is een veld opgenomen waar de mailadressen per organisatorische eenheid staan vermeld.
Het opslaan van de PDF bestanden per organisatorische eenheid gaat prima, helaas krijg ik het nog niet voor elkaar om een mail te sturen met het bestand dat toebehoort aan het mailadres zoals aangegeven in onze database.
Wie kan mij helpen?
Onderstaand hetgeen ik al geprobeerd heb en werkt muv het mailen:
Code:
Sub FilterAndExport()
Dim myDoc As Document
Set doc = Application.ActiveDocument
'doc.Refresh
Dim myrpt As Report
Dim myFilterVar As DocumentVariable
Dim myFilterChoices As Variant
Dim i, intNumChoices As Integer
Dim strNextValue As String
Dim OutApp As Object
Dim OutMail As Object
Dim mymail As DocumentVariable
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set myDoc = ActiveDocument
Set myrpt = ActiveReport
Set mymail = myDoc.DocumentVariables("Email")
Set myFilterVar = myDoc.DocumentVariables("Nr. Org. eenheid")
intNumChoices = UBound(myFilterVar.Values(boUniqueValues))
myFilterChoices = myFilterVar.Values(boUniqueValues)
For i = 1 To intNumChoices
On Error Resume Next
With OutMail
strNextValue = myFilterChoices(i)
myrpt.AddComplexFilter myFilterVar, "=<Nr. Org. eenheid>=" & strNextValue
myrpt.ForceCompute
.To = "=<Email>="
.Subject = "Formatieoverzicht " & strNextValue & " " & CStr(Day(Date)) & "-" & CStr(Month(Date)) & "-" & CStr(Year(Date))
.Body = vbCr & _
"Hallo, " & vbCr & vbCr & _
"Hierbij het formatieoverzicht van afdeling " & strNextValue & vbCr & vbCr & vbCr & _
"Met vriendelijke groet," & vbCr & vbCr & vbCr & _
"Peter"
myrpt.ExportAsPDF ("N:\" & "Formatie afd " & strNextValue & " " & CStr(Day(Date)) & "-" & CStr(Month(Date)) & "-" & CStr(Year(Date)) & ".pdf")
.Attachments.Add ("N:\" & "Formatie afd " & strNextValue & " " & CStr(Day(Date)) & "-" & CStr(Month(Date)) & "-" & CStr(Year(Date)) & ".pdf")
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Next i
End Sub
Laatst bewerkt:
