Sub EmailPDF()
Dim strData As String
Dim ola As Outlook.Application
Dim maiMessage As Outlook.MailItem
Dim strSiteName As String
strSiteName = Tables(1).Cell(1, 2).Range.Text
strUserName = Application.UserName
strData = "D:" & "Kiosk Request Form - " & strSiteName & ".pdf"
'Creates a PDF and stores it locally
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
strData, ExportFormat:= _
wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentWithMarkup, IncludeDocProps:=False, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
On Error Resume Next
'Start Outlook if it isn't running
Set oOutlookApp = GetObject("Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
End If
'Create a new message
Set oItem = oOutlookApp.CreateItem(olMailItem)
oItem.Subject = "Kiosk Request Form - "
oItem.To = "mark@industrialgrp.co.uk"
oItem.HTMLBody = "<html><style> p { font-family: Arial; font-size: 12; }</style>******><p>Please find attached an initial kiosk request form for " & strSiteName & ".</p><p>Any queries, please let me know</p><p>Kind regards,</P><p>" & strUserName & "</body></html>"
oItem.Display
'Add attachment
oItem.Attachments.Add strData
'Create a file system object to delete temporary file
Set fs = CreateObject("Scripting.FileSystemObject")
fs.deletefile strData
End Sub
Private Sub CommandButton1_Click()
Call EmailPDF
End Sub
