McTavish14
New Member
- Joined
- Dec 5, 2012
- Messages
- 18
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>
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>