#1
|
|||
|
|||
Macro to save as pdf with ability to choose save as folder
I was lucky enough to come across this macro on this forum to save as pdf but I need to alter a bit so that it allows the user to select the folder to save it in. Any ideas?
With ActiveDocument .ExportAsFixedFormat OutputFileName:=Split(.FullName, ".")(0) & ".pdf", _ ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, _ OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportAllDocument, _ Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _ CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _ BitmapMissingFonts:=True, UseISO19005_1:=False End With Thanks! |
#2
|
||||
|
||||
Hi rvessio,
Try: Code:
Sub SaveToPDF() With ActiveDocument .ExportAsFixedFormat OutputFileName:=GetFolder & "\" & Split(.Name, ".")(0) & ".pdf", _ ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, _ OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportAllDocument, _ Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _ CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _ BitmapMissingFonts:=True, UseISO19005_1:=False End With End Sub Function GetFolder() As String Dim oFolder As Object GetFolder = "" Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0) If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path Set oFolder = Nothing End Function
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Thanks that worked, the only thing is that if a file already exists with the same name it doesn't prompt to overwrite.
|
#4
|
||||
|
||||
Hi rvessio,
It would have been nice if you'd said you needed to check before overwriting. Try this variation: Code:
Sub SaveToPDF() Dim StrPath As String, StrName As String, Result With ActiveDocument On Error GoTo Errhandler StrPath = GetFolder & "\" StrName = Split(.Name, ".")(0) While Dir(StrPath & StrName & ".pdf") <> "" Result = InputBox("WARNING - A file already exists with the name:" & vbCr & _ Split(.Name, ".")(0) & vbCr & _ "You may edit the filename or continue without editing." _ & vbCr & vbTab & vbTab & vbTab & "Proceed?", "File Exists", StrName) If Result = vbCancel Then Exit Sub If StrName = Result Then GoTo Overwrite StrName = Result Wend Overwrite: .ExportAsFixedFormat OutputFileName:=StrPath & StrName & ".pdf", _ ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, _ OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportAllDocument, _ Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _ CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _ BitmapMissingFonts:=True, UseISO19005_1:=False End With Errhandler: End Sub Function GetFolder() As String Dim oFolder As Object GetFolder = "" Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0) If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path Set oFolder = Nothing End Function
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
Add pdf to email
Hello,
I found this code in the thread below very useful but would like to take it one step further. After the pdf is created, I would like to add it to an Outlook email and distribute it. Any help would be great. Thanks! Julie Sub SaveToPDF() Dim StrPath As String, StrName As String, Result With ActiveDocument On Error GoTo Errhandler StrPath = GetFolder & "\" StrName = Split(.Name, ".")(0) While Dir(StrPath & StrName & ".pdf") <> "" Result = InputBox("WARNING - A file already exists with the name:" & vbCr & _ Split(.Name, ".")(0) & vbCr & _ "You may edit the filename or continue without editing." _ & vbCr & vbTab & vbTab & vbTab & "Proceed?", "File Exists", StrName) If Result = vbCancel Then Exit Sub If StrName = Result Then GoTo Overwrite StrName = Result Wend Overwrite: .ExportAsFixedFormat OutputFileName:=StrPath & StrName & ".pdf", _ ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, _ OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportAllDocument, _ Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _ CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _ BitmapMissingFonts:=True, UseISO19005_1:=False End With Errhandler: End Sub Function GetFolder() As String Dim oFolder As Object GetFolder = "" Set oFolder = CreateObject("Shell.Application").BrowseForFolder( 0, "Choose a folder", 0) If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path Set oFolder = Nothing End Function |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Macro to save as PDF but with a different name | shabbaranks | Word VBA | 2 | 05-20-2011 01:02 AM |
Macro to Save Help | clarkson001 | Word | 0 | 02-14-2011 06:41 AM |
Does not SAVE AS to default folder | pleveque | Office | 0 | 01-13-2011 08:34 AM |
Macro Won't Save | lou0915 | Word VBA | 2 | 10-17-2009 08:13 PM |
How can I save multiple email messages to a file folder? (crosspost) | tupham | Outlook | 0 | 08-04-2008 07:56 PM |