![]() |
|
#1
|
|||
|
|||
|
Hello there,
I need to be able to save all documents in a specified folder, while retaining those documents original file names. Note: I read previously where someone was having issues with emailing the saved pdfs thereafter, but wasn't able to figure out what was done to correct that issue. As I haven't gotten to that point yet, I am not certain about the issue with emailing the pdfs after the fact, but I can say that I will need to be able to email the pdf documents after they have been saved/converted from another doc type Code: Code:
Sub AcceptSave() ' ' AcceptSave Macro ' ' ActiveDocument.AcceptAllRevisions ActiveDocument.TrackRevisions = False Application.Run MacroName:="Silent_save_to_PDF" ActiveDocument.Save End Sub Sub Silent_save_to_PDF() ' ' Silent_save_to_PDF Macro ' ActiveDocument.ExportAsFixedFormat OutputFileName:= _ Replace(ActiveDocument.FullName, ".docx", ".pdf"), _ ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _ wdExportOptimizeForPrint, Range:=wdExportAllDocument, Item:= _ wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=True, _ CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _ BitmapMissingFonts:=True, UseISO19005_1:=False End Sub |
|
#2
|
||||
|
||||
|
Try:
Code:
Sub ConvertDocs2PDFs()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
strDocNm = ActiveDocument.FullName
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
If strFolder & "\" & strFile <> strDocNm Then
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
.SaveAs FileName:=Split(.FullName, ".doc")(0) & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
.Close SaveChanges:=False
End With
End If
strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
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
|
|||
|
|||
|
Thank you very much,
As I am extremely new to Macros (I plan on taking courses over the coming weeks), will I simply use your code to create a new macros and then add that to my existing macros that accepts all changes to the word document I am working on? |
|
#4
|
||||
|
||||
|
I already posted a link telling you how to install & use the macro...
As for accepting changes, although your own macro has code for that, it's not apparent how that's relevant to a folder full of documents. Are you suggesting those documents, too, might have tracked changes that you want accepted? If so, after: With wdDoc insert: Code:
.TrackRevisions = False
.AcceptAllRevisions
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#5
|
|||
|
|||
|
Thank you so much Paul,
I wasn't suggesting anything, just so much of a novice I didn't realize you provided me a link so that I can use. Thanks again and my apologies if I came off as daft. |
|
| Tags |
| loop, save as pdf, vba |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
Run macro to save multiple word docs and xml
|
Prateep Nath | Word VBA | 1 | 02-05-2018 02:52 PM |
Macro to save as pdf with ability to choose save as folder
|
rvessio | Word VBA | 4 | 07-25-2016 12:37 PM |
Import a specific range (bookmarked section) from all Word docs in a selected folder
|
Greengecko | Word VBA | 5 | 06-14-2016 07:54 AM |
Word always brings up 'Save As' dialogue when I try to Save - same for all Word docs
|
stuartb | Word | 1 | 08-18-2014 12:26 PM |
HELP: Microsoft Office won't save docs.
|
Pjbarasi | Word | 1 | 01-18-2012 04:57 PM |