Excelsheet versturen als PDF met Outlook in VBScript

In de regel voeren we programmeerwerkzaamheden voor maatwerk websites en software uit, gemaakt in Php en Java. Soms moet er ook aansluiting worden gevonden met de office software dat gebruikt wordt. Vaak is dit Microsoft Office, maar steeds vaker komen we ook LibreOffice tegen.

Recent had een klant de wens om automatisch de handtekening toe te voegen als hij een PDF verstuurde vanuit Excel met Microsoft Outlook. Na wat speuren op internet bleek het - tot enige verbazing - niet mogelijk dit in te stellen. Uiteraard als programmeer-club is het moeilijk nee zeggen, dus werd er naar een mogelijkheid gezocht. Deze werd gevonden in vba aka Visual Basic for Applications. In Excel is het mogelijk macro's te maken met VBScript en deze vervolgens in de menubalk toe te voegen.

De gemaakte oplossing is een vbscript macro welke de Excelsheet naar PDF converteert en vervolgens een mail in Outlook aanmaakt met attachment en handtekening. Dit script is gekoppeld aan een nieuwe knop in de Excel ribbon.

Sub VerstuurPerMail()

  '' default signature
  textSignature = vbLf _
            & vbLf _
            & "Met vriendelijke groet," & vbLf _
            & "Tim"
  
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  '' signature file? => fetch data
  Set objShell = CreateObject("WScript.Shell")
  txtFileSignature = objShell.SpecialFolders("MyDocuments") & "\\handtekening-excel-pdf.txt"
  
  If fso.FileExists(txtFileSignature) Then
    Set file = fso.OpenTextFile(txtFileSignature, 1)
    textSignature = file.ReadAll
    file.Close
  End If
  
 
  ' set pdf filename
  tmpFolder = fso.GetSpecialFolder(2)
  PdfFile = tmpFolder & "\" & LCase(ActiveSheet.Name) & ".pdf"
 
  ' export sheet as pdf
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' open outlook
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' set signature & attachment
  With OutlApp.CreateItem(0)
    ' Prepare e-mail
    .Body = textSignature
    
    .Attachments.Add PdfFile
   
    ' display mail window
    .Display
  End With
 
  ' delete pdf
  Kill PdfFile
 
  Set OutlApp = Nothing

End Sub

Opzoek naar een programmeur voor VBScript, VBA, Php, Java, databases of iets anders? Neem contact op!

Gerelateerd

07-07-2016

WMI scripting example