Exporting Word doc to VBA - Help!

[McTavish14]

Hi,

I've got the following code that creates a letter (in Word) from an existing standard template, populates it accordingly and then saves it. The next step is then to start Outlook, create and email and attach the created letter.

However, what I need to do is not save the created letter as a Word doc, but instead as a PDF and I'm struggling to find code that I can take and use or write the code.

Any help with this is greatly appreciated:

'Letter</SPAN>
Dim objWord As Object</SPAN>

Set objWord = CreateObject("Word.Application")</SPAN>

'Creates Lending Discretions Letter</SPAN>

Dim WordDoc As String</SPAN>

WordDoc = FilePath & "\Issued Letters\Discretion Letter" & " - " & rsFilterCriteria("Forename").Value & " " & rsFilterCriteria("Surname").Value & " " & rsFilterCriteria("BRID").Value & " - " & Format(Now(), "dd-mm-yyyy") & ".doc"</SPAN>

With objWord.Activedocument</SPAN>
.Bookmarks("Forename").Range.Text = rsFilterCriteria("Forename").Value</SPAN>
.Bookmarks("Forename2").Range.Text = rsFilterCriteria("Forename").Value</SPAN>
.Bookmarks("Surname").Range.Text = rsFilterCriteria("Surname").Value</SPAN>
.Bookmarks("BRID").Range.Text = rsFilterCriteria("BRID").Value</SPAN>
.Bookmarks("Role").Range.Text = rsFilterCriteria("Job_Role").Value</SPAN>
.Bookmarks("Team").Range.Text = rsFilterCriteria("Team").Value</SPAN>
.Bookmarks("Date").Range.Text = Format(Date, "dd mmmm yyyy")</SPAN>
.Bookmarks("FDG1to10").Range.Text = Format(rsFilterCriteria("Disc_DG_1-10").Value, </SPAN>
.Bookmarks("FDG11to12").Range.Text = Format(rsFilterCriteria("Disc_DG_11-128").Value, </SPAN>
.Bookmarks("FDG13to16").Range.Text = Format(rsFilterCriteria("Disc_DG_13-16").Value, </SPAN>
.Bookmarks("FDG17to21").Range.Text = Format(rsFilterCriteria("Disc_DG_17-21").Value, </SPAN>
.Bookmarks("NewBus").Range.Text = Format(rsFilterCriteria("Disc_New_Business").Value, </SPAN>
.Protect Password:="Gizmo", NoReset:=True, Type:=3, UseIRM:=False, EnforceStyleLock:=False</SPAN>
.SaveAs (WordDoc)</SPAN>
.Close</SPAN>
End With</SPAN>

objWord.Visible = True</SPAN>
objWord.Quit</SPAN>



Set objWord = Nothing</SPAN>
Set objWordVal = Nothing</SPAN>

Dim Outlook As Application</SPAN>
Dim OutlookApp As Object</SPAN>
Dim MailItem As Object</SPAN>

Set OutlookApp = CreateObject("Outlook.Application")</SPAN>

‘Email</SPAN>
Set MailItem = OutlookApp.CreateItemFromTemplate(FilePath & "\Templates\Change Discretions.oft")</SPAN>

With MailItem</SPAN>
.To = CreditOfficerEmail</SPAN>
'If CreditOfficerEmail <> RCDEmail Then</SPAN>
' .CC = RCDEmail</SPAN>
'End If</SPAN>
.BCC = "steve.nicholls@barclays.com"</SPAN>
.Subject = "ACTION REQUIRED - Your Lending Discretions"</SPAN>
.Attachments.Add WordDoc</SPAN>
If rsFilterCriteria("Disc_Valuation_Flag").Value = 1 Then</SPAN>
.Attachments.Add WordDocVal</SPAN>
End If</SPAN>
'.Display</SPAN>
.Send</SPAN>
End With</SPAN>



Set MailItem = Nothing</SPAN>
Set OutlookApp = Nothing</SPAN>

 

[Macropod]

Change:
WordDoc = FilePath & "\Issued Letters\Discretion Letter" & " - " & rsFilterCriteria("Forename").Value & " " & rsFilterCriteria("Surname").Value & " " & rsFilterCriteria("BRID").Value & " - " & Format(Now(), "dd-mm-yyyy") & ".doc"
to:
WordDoc = FilePath & "\Issued Letters\Discretion Letter" & " - " & rsFilterCriteria("Forename").Value & " " & rsFilterCriteria("Surname").Value & " " & rsFilterCriteria("BRID").Value & " - " & Format(Now(), "dd-mm-yyyy") & ".pdf"
and use:
.SaveAs2 FileName:=WordDoc, FileFormat:=wdFormatPDF, AddToRecentFiles:=False
.Close SaveChanges:=False

PS: When posting code, please use the code tags. They're on the 'Go Advanced' tab at the bottom of this screen.
PPS: Your lines with '= Format(rsFilterCriteria(' are all missing the second half of the Format statements.