Help! Macro to Save a .doc or .docx as a .pdf in ActiveDocument.Path

[jbiggar]

This is my first experience with vba/macros. I need help creating a macro to save a Word Document existing in a folder as a PDF in the same folder with the same file name. I tried using the macro recorder but it will only work with that specific file name as shown below:


Sub SaveAsPDF()
'
' SaveAsPDF Macro
'
'
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
"Q:\namerica\Phoenix\workgrps\LAB\Public\CRN\1234567890\1234567890.pdf", _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
ChangeFileOpenDirectory _
"Q:\namerica\Phoenix\workgrps\LAB\Public\CRN\1234567890\"
End Sub


If anyone has any guidance for me to apply this macro so whenever I open a word document which is alreaady saved as the file name I want to save the pdf as in the active folder it will help me and possibly other out greatly.

Below is some code I was playing with. Not sure if it could be used.

Dim fname As String

fname = ActiveDocument.Name

If ActiveDocument.Name is a ".doc" or ".docx"
Then remove the .doc or .docx

fname = the ActiveDocumentName with the .doc or .docx extension stripped

Dim fpath As String

fpath = ActiveDocument.Path

fpath = fpath & "\" & fname

[jbiggar]

Sub SaveAsPDF()

Dim strFileName As String

'remove .doc or .docx from filename
If UCase(Right(ActiveDocument.Name, 1)) = "X" Then

'.docx
strFileName = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 5)

Else

'.doc
strFileName = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 4)

End If

'write the PDF file
ActiveDocument.ExportAsFixedFormat OutputFileName:=ActiveDocument.Path & "\" & strFileName & ".pdf", _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, _
Item:=wdExportDocumentContent, _
IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, _
DocStructureTags:=True, _
BitmapMissingFonts:=True, _
UseISO19005_1:=False

'all done
MsgBox "PDF complete"

End Sub

[fumei]

Or....

Dim j As Long
j = InStr(ActiveDocument.Name, ".")

ActiveDocument.ExportAsFixedFormat OutputFileName:= _
ActiveDocument.Path & "\" & Left(ActiveDocument.Name, j) & "pdf", _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False

[jbiggar]

Thank you fumei.

[Paul_Hossler]

Actually if there are embedded dots in the filename (e.g. Sample.Today.Realsoon.doc)


j = InStr(ActiveDocument.Name, ".")


would only find the first dot ('Sample')


I'd 'back into it' with InStrRev



Option Explicit
Sub drv()
Dim j As Long

j = InStrRev(ActiveDocument.FullName, ".")

ActiveDocument.ExportAsFixedFormat _
OutputFileName:=Left(ActiveDocument.FullName, j) & "pdf", _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportAllDocument, _
From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
End Sub


Paul

[fumei]

Paul is absolutely correct. If there are multiple (even 2) dots, it breaks down. And using InStrRev solves it.