Run Code on all files and save files as .docx

Plokimu77 · #1 06-03-2016, 08:40 PM

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

macropod · #2 06-03-2016, 10:27 PM

You could simply change:
.Close SaveChanges:=True
to:

Code:

    .SaveAs2 FileName:=strFolder & "\" & Split(strFile, ".")(0) & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    .Close SaveChanges:=False

PS: When posting code, please use the code tags, indicated by the # button on the posting menu. Without them, your code loses much of whatever structure it had.

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

since a few lines later you have:
.Orientation = wdOrientLandscape

Plokimu77 · #3 06-05-2016, 02:23 PM

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!

macropod · #4 06-05-2016, 04:24 PM

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

Plokimu77 · #5 06-05-2016, 04:41 PM

EXCELLENT!!

Thank you so much!!

You have saved me hours of work!!

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

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