#1
|
|||
|
|||
Run Code on all files and save files as .docx
Forum, What would I need to add to my code below, so it can save the converted files as .docx and with the same name as the file that was opened? Thank you Code:
Sub UpdateDocuments() Application.ScreenUpdating = False Dim strFolder As String, strFile As String, wdDoc As Document strFolder = GetFolder If strFolder = "" Then Exit Sub strFile = Dir(strFolder & "\*.*", vbNormal) While strFile <> "" Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False) With wdDoc Call DDS .Close SaveChanges:=True End With 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 Sub DDS() Selection.WholeStory If Selection.PageSetup.Orientation = wdOrientPortrait Then Selection.PageSetup.Orientation = wdOrientLandscape Else Selection.PageSetup.Orientation = wdOrientPortrait End If Selection.WholeStory Selection.Font.Shrink Selection.Font.Shrink With Selection.PageSetup .LineNumbering.Active = False .Orientation = wdOrientLandscape .TopMargin = InchesToPoints(0.5) .BottomMargin = InchesToPoints(0.5) .LeftMargin = InchesToPoints(0.5) .RightMargin = InchesToPoints(0.5) .Gutter = InchesToPoints(0) .HeaderDistance = InchesToPoints(0.5) .FooterDistance = InchesToPoints(0.5) .PageWidth = InchesToPoints(11) .PageHeight = InchesToPoints(8.5) .FirstPageTray = wdPrinterDefaultBin .OtherPagesTray = wdPrinterDefaultBin .SectionStart = wdSectionNewPage .OddAndEvenPagesHeaderFooter = False .DifferentFirstPageHeaderFooter = False .VerticalAlignment = wdAlignVerticalTop .SuppressEndnotes = False .MirrorMargins = False .TwoPagesOnOne = False .BookFoldPrinting = False .BookFoldRevPrinting = False .BookFoldPrintingSheets = 1 .GutterPos = wdGutterPosLeft End With End Sub Last edited by macropod; 06-03-2016 at 10:30 PM. Reason: Added code tags & formatting |
#2
|
||||
|
||||
You could simply change:
.Close SaveChanges:=True to: Code:
.SaveAs2 FileName:=strFolder & "\" & Split(strFile, ".")(0) & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False .Close SaveChanges:=False PPS: I can't see the point of: Code:
If Selection.PageSetup.Orientation = wdOrientPortrait Then Selection.PageSetup.Orientation = wdOrientLandscape Else Selection.PageSetup.Orientation = wdOrientPortrait End If .Orientation = wdOrientLandscape
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Almost there.
The files got save and converted to docx, but the code from Sub DDS did not take effect on any of the docx files. Thank you for your time and assistance! |
#4
|
||||
|
||||
Try:
Code:
Sub UpdateDocuments() Application.ScreenUpdating = False Dim strFolder As String, strFile As String, wdDoc As Document strFolder = GetFolder If strFolder = "" Then Exit Sub strFile = Dir(strFolder & "\*.doc", vbNormal) While strFile <> "" Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False) Call DDS(wdDoc) With wdDoc .SaveAs2 FileName:=strFolder & "\" & Split(strFile, ".")(0) & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False .Close SaveChanges:=False End With 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 Sub DDS(wdDoc As Document) With wdDoc.Range .Font.Shrink .Font.Shrink With .PageSetup .Orientation = wdOrientLandscape .LineNumbering.Active = False .TopMargin = InchesToPoints(0.5) .BottomMargin = InchesToPoints(0.5) .LeftMargin = InchesToPoints(0.5) .RightMargin = InchesToPoints(0.5) .Gutter = InchesToPoints(0) .HeaderDistance = InchesToPoints(0.5) .FooterDistance = InchesToPoints(0.5) .PageWidth = InchesToPoints(11) .PageHeight = InchesToPoints(8.5) .FirstPageTray = wdPrinterDefaultBin .OtherPagesTray = wdPrinterDefaultBin .SectionStart = wdSectionNewPage .OddAndEvenPagesHeaderFooter = False .DifferentFirstPageHeaderFooter = False .VerticalAlignment = wdAlignVerticalTop .SuppressEndnotes = False .MirrorMargins = False .TwoPagesOnOne = False .BookFoldPrinting = False .BookFoldRevPrinting = False .BookFoldPrintingSheets = 1 .GutterPos = wdGutterPosLeft End With End With End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
EXCELLENT!!
Thank you so much!! You have saved me hours of work!! |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Run a macro on multiple docx. files | Peter Carter | Word VBA | 27 | 12-15-2022 04:10 PM |
Corrupted .docx files | Mayberry | Word | 0 | 08-29-2015 03:17 AM |
Macros now ok in docx files? | techwriterrc12 | Word VBA | 4 | 05-09-2013 10:47 AM |
How to open Docx files? | mond_bees | Word | 12 | 08-29-2012 03:32 AM |
Icon for docx files | Jazz43 | Word | 2 | 10-20-2009 08:34 PM |