Saving Word file with Specific File Name from Content Control to PDF

[bgbootha]

Hello guys, I am completely new to this and hoping to get this to work.

I need my word document to save as a pdf to a certain directory (which I can do). But I need it to save with a specific file name from a user entered content controrl form field.

For instance, I have a content control text field titled "TeacherName", I want my file to save via macro as MMDDTeacherName.pdf

Thanks

[Jay Freedman]

There are a fair number of possible error conditions to check for before you can run the actual SaveAs command. For example, the content control could be empty or missing (deleted), or it could contain characters that aren't valid in a filename. The following code tries to take care of those, although there might be others.

Store the macro in a module in your template, and assign a keyboard shortcut to the macro -- for example, Shift+F12, which you can steal away from the Save command that already has Ctrl+S.


Sub FileSaveAsPDF()
Dim path As String
Dim fn As String
Dim ccs As ContentControls
Dim cc As ContentControl

' If doc has already been saved once,
' allow saving it to another location.
If Len(ActiveDocument.path) > 0 Then
Dialogs(wdDialogFileSaveAs).Show
Exit Sub
End If

' Get the content control
Set ccs = ActiveDocument.SelectContentControlsByTitle("TeacherName")
If ccs.Count = 1 Then
Set cc = ccs(1)
ElseIf ccs.Count = 0 Then
MsgBox "The content control titled 'TeacherName' is missing.", , "Error"
Exit Sub
Else
MsgBox "There is more than one content control titled 'TeacherName'.", , "Error"
Exit Sub
End If

path = "C:\temp\" ' whatever folder you want, but be sure to end with backslash
fn = cc.Range.Text

' Validate file name
If cc.ShowingPlaceholderText Or Len(fn) = 0 Then
MsgBox "An entry is required in the 'TeacherName' content control.", , "Error"
cc.Range.Select
Exit Sub
End If

If InStr(fn, "\") Or InStr(fn, "/") Or InStr(fn, ":") Or InStr(fn, "*") _
Or InStr(fn, "?") Or InStr(fn, "<") Or InStr(fn, ">") Or InStr(fn, Chr(34)) Then
MsgBox "The TeacherName cannot contain the characters \/:*?" & Chr(34) & "<>", , "Error"
cc.Range.Select
Exit Sub
End If

' Finally, do what we came here to do...
On Error Resume Next
fn = Format(Now, "MMdd") & fn & ".pdf"
ActiveDocument.SaveAs2 FileName:=path & fn, FileFormat:=wdFormatPDF
If Err.Number = 0 Then
MsgBox "The file was saved as " & path & fn, , "Saved"
Else
MsgBox "Error " & Err.Number & vbCr & Err.Description
End If
End Sub

[bgbootha]

Jay,

Thanks for the help, however I am getting an error.

Unexpected End Sub

I am not sure why I am getting this here.

[Jay Freedman]

When you put the code into your macro editor, did you accidentally (a) omit the first line, Sub FileSaveAsPDF(), or (b) somehow get two copies of the last line, End Sub?

There should be exactly one Sub line, only at the beginning, and exactly one End Sub line, only at the end.

[bgbootha]

YOU ROCK!!!

I didn't erase the name of the macro that I was copy and pasting this into to. So I had two 'first' lines. THank you so much!

[bgbootha]

Ok so one more question....after it is saved as a PDF, we want to be able to automatically attach it to an outlook email. In Excel I was able to do this pretty easily, but now in word I am not able to make it work, with your code on top, this is what I added to a the bottom trying to get it to work.



Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)


With Destwb
'.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
' Change the mail address and subject in the macro before
' running the procedure.
With OutMail
.To = ""
.cc = ""
.BCC = ""
.Subject = "Tacoma Public Schools 5D Scripting Tool"
.Body = ""
.Attachments.Add Destwb.FullName
' You can add other files by uncommenting the following statement.
.Attachments.Add ("c:\5D\" & Format(Now, "MMdd") & fn & ".pdf")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Display
End With
On Error GoTo 0
'.Close SaveChanges:=False


Obviously I have changed the desitnation folder to reflect C:\5D\ in all the code from earlier as well.

[Jay Freedman]

I can reproduce your problem (if it is that the mail item comes up with no attachments). It looks to me like the cause is that OutApp and OutMail are not declared specifically as the data types Outlook.Application and Outlook.MailItem, respectively. In order to do that, you have to click Tools > References in the VBA editor and check the box for the Microsoft Outlook Object Model. Then you can use this code, added to my previous macro:


' prepare email
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem

On Error Resume Next
Set OutApp = GetObject("Outlook.Application")
If OutApp Is Nothing Then
Set OutApp = CreateObject("Outlook.Application")
End If
Set OutMail = OutApp.CreateItem(0)
If OutMail Is Nothing Then
MsgBox "Failed to create mail item."
Exit Sub
End If

With OutMail
.To = ""
.cc = ""
.BCC = ""
.Subject = "Tacoma Public Schools 5D Scripting Tool"
.Attachments.Add Destwb.FullName
.Attachments.Add Source:=path & fn
.Display
End With

[bgbootha]

This is what I have so far, with both of your codes put one right after each other.



Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)


With Destwb
'.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
' Change the mail address and subject in the macro before
' running the procedure.
With OutMail
.To = ""
.cc = ""
.BCC = ""
.Subject = "Tacoma Public Schools 5D Scripting Tool"
.Body = ""
.Attachments.Add Destwb.FullName
' You can add other files by uncommenting the following statement.
.Attachments.Add ("c:\5D\" & Format(Now, "MMdd") & fn & ".pdf")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Display
End With
On Error Goto 0
'.Close SaveChanges:=False


However, its not working all it does is save to the folder as a docx, not even as a PDF and won't go any further.

Thanks again for all your help on this. I owe you a beer or two

[bgbootha]

This is what I have so far, with both of your codes put one right after each other.


Sub SAVEandEMAIL2()'
' SAVEandEMAIL2 Macro
'
'
Dim path As String
Dim fn As String
Dim ccs As ContentControls
Dim cc As ContentControl

' If doc has already been saved once,
' allow saving it to another location.
If Len(ActiveDocument.path) > 0 Then
Dialogs(wdDialogFileSaveAs).Show
Exit Sub
End If

' Get the content control
Set ccs = ActiveDocument.SelectContentControlsByTitle("TeacherName")
If ccs.Count = 1 Then
Set cc = ccs(1)
ElseIf ccs.Count = 0 Then
MsgBox "The content control titled 'TeacherName' is missing.", , "Error"
Exit Sub
Else
MsgBox "There is more than one content control titled 'TeacherName'.", , "Error"
Exit Sub
End If

path = "C:\5D\" ' whatever folder you want, but be sure to end with backslash
fn = cc.Range.Text

' Validate file name
If cc.ShowingPlaceholderText Or Len(fn) = 0 Then
MsgBox "An entry is required in the 'TeacherName' content control.", , "Error"
cc.Range.Select
Exit Sub
End If

If InStr(fn, "\") Or InStr(fn, "/") Or InStr(fn, ":") Or InStr(fn, "*") _
Or InStr(fn, "?") Or InStr(fn, "<") Or InStr(fn, ">") Or InStr(fn, Chr(34)) Then
MsgBox "The TeacherName cannot contain the characters \/:*?" & Chr(34) & "<>", , "Error"
cc.Range.Select
Exit Sub
End If

' Finally, do what we came here to do...
On Error Resume Next
fn = Format(Now, "MMdd") & fn & ".pdf"
ActiveDocument.SaveAs2 FileName:=path & fn, FileFormat:=wdFormatPDF
If Err.Number = 0 Then
MsgBox "The file was saved as " & path & fn, , "Saved"
Else
MsgBox "Error " & Err.Number & vbCr & Err.Description
End If

' prepare email
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem

On Error Resume Next
Set OutApp = GetObject("Outlook.Application")
If OutApp Is Nothing Then
Set OutApp = CreateObject("Outlook.Application")
End If
Set OutMail = OutApp.CreateItem(0)
If OutMail Is Nothing Then
MsgBox "Failed to create mail item."
Exit Sub
End If

With OutMail
.To = ""
.cc = ""
.BCC = ""
.Subject = "Tacoma Public Schools 5D Scripting Tool"
.Attachments.Add Destwb.FullName
.Attachments.Add Source:=path & fn
.Display
End With






End Sub

However, its not working all it does is save to the folder as a docx, not even as a PDF and won't go any further.

Thanks again for all your help on this. I owe you a beer or two

[Jay Freedman]

I have a feeling that I'm missing something about your arrangement. First, what program is running this macro? I assumed it was Word, but where is Destwb coming from (I gather that's an Excel workbook, but it isn't declared or defined in this macro). I'm working in Word, and I've commented out the .Attachment line that refers to Destwb.

If it is Word, are you getting any kind of error messages when you run it? Have you tried running it within the macro editor, one line at a time by pressing F8, and checking the values of variables as they change? (You can use the Watch window for that -- right-click a variable or expression and click Add Watch).

Since the statement that does the save is
ActiveDocument.SaveAs2 FileName:=path & fn, FileFormat:=wdFormatPDF
and the fn variable includes a .pdf extension, I have a hard time seeing how it can possibly save as a docx file -- unless the macro is running in Excel and wdFormatPDF is undefined and thus has the value 0.

Another thing that will help a lot is to go to the top of the macro code and insert the line
Option Explicit
That causes the editor to throw an error for any variable name that isn't explicitly declared.

[bgbootha]

I was copying the wrong code, I was using some old code from an old excel file to build this one....I saw that as well, and fixed it.

It is working great on my machine, doing everything I want....now I am trying to figure out how to send this to colleagues and have the macros still work on their machines.