Mass Formatting of Files

gmayor · #1 03-28-2015, 11:43 PM

The following will perform the intended task on doc format files in the selected folder. It also provides the option to cancel the task, and ignores docx files. It also uses ranges instead of the selection object:

Code:

Sub MassFormatFiles()
'
' MassFormatFiles Macro
' Page Setup dialog box. Thus, things like paper size, margins, header and footer locations, and orientation
'
Dim strFilename As String
Dim strPath As String
Dim oDoc As Document
Dim fDialog As FileDialog

    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

    With fDialog
        .Title = "Select folder and click OK"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then
            MsgBox "Cancelled By User", , _
                   "List Folder Contents"
            Exit Sub
        End If
        strPath = fDialog.SelectedItems.Item(1)
        If Len(strPath) > 3 Then strPath = strPath & Chr(92)
    End With

    If Left(strPath, 1) = Chr(34) Then
        strPath = Mid(strPath, 2, Len(strPath) - 2)
    End If

    strFilename = Dir$(strPath & "*.doc")
    Application.ScreenUpdating = False
    While Len(strFilename) <> 0
        If Right(LCase(strFilename), 3) = "doc" Then
            WordBasic.DisableAutoMacros 1
            Set oDoc = Documents.Open(strPath & strFilename)

            With oDoc.PageSetup
                .LineNumbering.Active = False
                .Orientation = wdOrientPortrait
                .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(8.5)
                .PageHeight = InchesToPoints(11)
                .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
            With oDoc.Range
                .Font.Name = "Times New Roman"
                .Font.Size = 12
                With .Paragraphs(1).Range
                    .Style = ActiveDocument.Styles("Heading 1")
                    .Font.Name = "Times New Roman"
                    .Font.Size = 22
                    .Font.Color = 192
                End With
            End With

            oDoc.Close SaveChanges:=wdSaveChanges
            WordBasic.DisableAutoMacros 0
        End If
        strFilename = Dir$()
    Wend
    Application.ScreenUpdating = True
lbl_Exit:
    Exit Sub
End Sub

Note that this version only addresses the main document body. Other story ranges need to be processed separately, though this was equally true of the original.

It would be better if you created and applied the required styles to the text rather than manual formatting, as this makes it so much simpler to edit next time.

DOC format can store macros. You don't want automacros to run while running the process, so that too has been addressed.

If you want to process sub folders see

http://www.gmayor.com/document_batch_processes.htm

WH7262 · #2 03-29-2015, 01:17 PM

First let me start by saying to you, "Thank You Sir for re-editing this macro."

I deleted all macros, only had one, and created your macro back into Word. At this point in time, still had some files in specified directory used for modifying of files.

Start Word, ran your macro, selected the Directory where the files were being stored that needed the macro to be ran on and, it failed, but on the following line:
Set oDoc = Documents.Open(strPath & strFilename)

So decided to shut down computer completely and start it back up again.

Started Word again, then your macro, again it failed on the same line as mentioned above.

Decided that maybe running macro on 20 files might be a bit much, so deleted that 15 files. Don't worry, these were only copies of the originals. Try it again, still failed.

Shut down Word and restarted it from the command line running the command:
winword.exe \m
This is to start Word without running any AutoExec macros, and guess what it failed again, same spot.

At this point in time, I was determined to find the cause on my own, if possible. So I started by replacing the files I had with other files that needed to be corrected.

Shut computer down and restarted. Started Word back up, ran your macro, selected the Directory where the files were being stored that needed the macro to be ran on and, IT WORKED!!!

Now why did it work this time? Went back to look at the files I had removed and the only difference in their file names was one had a number at the beginning of the it's file name. I wondered if this was the culprit?? But first, I wanted to keep running the now working macro for awhile. Ran about 300 files through, with sometimes having 80 files to be gone through, NO Issues.

So now is the time to that numbered file again. Placed it in the same directory along with the existing newly modified files. Ran the macro again, it failed. Now I was thinking why did it failed, so I renamed it without a number start off. Re-ran macro, IT WORKED.

Now tried another file that had a number at the start of it's file name and low and behold, it did not fail. It was the file itself, do not know what the issues were that kept the macro crashing, but I have attached for others to try as well. It does not have any viruses and etc. in it.

Thanks again sir for your hard work and time.

Bill

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Need macro to merge files in Word and preserve formatting	Carolin	Word VBA	3	12-14-2014 04:01 AM
Oulook Mass Mailing	mak39	Outlook	1	12-23-2013 10:15 AM
Mass replacing word(s)	alysolyman	Word VBA	10	02-27-2013 01:56 PM
Mass e-mail seperation	daryl	Mail Merge	1	03-23-2010 03:45 PM
Mass attachment downloads?	dpool2002	Outlook	1	06-21-2006 02:11 PM