Solved

MS Word macro to run on all documents within a directory

Posted on 2014-12-07
5
504 Views
Last Modified: 2014-12-08
Hi - I'd just like to start off with a warning that while I'm pretty OK with computers, I'm no expert when it comes to VBA and MS Word macros.

Anyways, we have a MS Word macro that is being used to update formatting for documents on a manual level.
I wanted to know if there is a way that I can make the macro run on all MS Word documents within a specified Windows director (which is likely to be a network location eg: \\192.168.1.100\Templates\Office1).

The current macro (has two iterations) is used by saving the macro to a macro-enabled document template and placing the template in the Word Startup folder.  Then the user just opens a document from our Document Management System and presses one of the two buttons that are located in the quick access toolbar.

Here's the current Macro for iteration 2 (iteration 1 just leaves out the changes pertaining to "STLF Ref"):

Sub SLF1()
          With ActiveDocument.Styles("Footer").Font
        .Name = "Open Sans Light"
        .Size = 7
        .Bold = False
        .Italic = False
        .Underline = wdUnderlineNone
        .UnderlineColor = wdColorAutomatic
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .Emboss = False
        .Shadow = False
        .Hidden = False
        .SmallCaps = False
        .AllCaps = False
        .Color = wdColorAutomatic
        .Engrave = False
        .Superscript = False
        .Subscript = False
        .Scaling = 100
        .Kerning = 0
        .Animation = wdAnimationNone
        .Ligatures = wdLigaturesNone
        .NumberSpacing = wdNumberSpacingDefault
        .NumberForm = wdNumberFormDefault
        .StylisticSet = wdStylisticSetDefault
        .ContextualAlternates = 0
    End With
    With ActiveDocument.Styles("Footer").ParagraphFormat
        .LeftIndent = CentimetersToPoints(0)
        .RightIndent = CentimetersToPoints(0)
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceSingle
        .Alignment = wdAlignParagraphLeft
        .WidowControl = True
        .KeepWithNext = False
        .KeepTogether = False
        .PageBreakBefore = False
        .NoLineNumber = False
        .Hyphenation = True
        .FirstLineIndent = CentimetersToPoints(0)
        .OutlineLevel = wdOutlineLevelBodyText
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
        .LineUnitBefore = 0
        .LineUnitAfter = 0
        .MirrorIndents = False
        .TextboxTightWrap = wdTightNone
        .CollapsedByDefault = False
    End With
    ActiveDocument.Styles("Footer").NoSpaceBetweenParagraphsOfSameStyle = _
        False
    ActiveDocument.Styles("Footer").ParagraphFormat.TabStops.ClearAll
    With ActiveDocument.Styles("Footer")
        .AutomaticallyUpdate = False
        .BaseStyle = "Normal"
        .NextParagraphStyle = "Footer"
    End With
    With ActiveDocument.Styles("STLF Ref").Font
        .Name = "Arial"
        .Size = 8.5
        .Bold = False
        .Italic = False
        .Underline = wdUnderlineNone
        .UnderlineColor = wdColorAutomatic
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .Emboss = False
        .Shadow = False
        .Hidden = False
        .SmallCaps = False
        .AllCaps = False
        .Color = wdColorAutomatic
        .Engrave = False
        .Superscript = False
        .Subscript = False
        .Scaling = 100
        .Kerning = 0
        .Animation = wdAnimationNone
        .Ligatures = wdLigaturesNone
        .NumberSpacing = wdNumberSpacingDefault
        .NumberForm = wdNumberFormDefault
        .StylisticSet = wdStylisticSetDefault
        .ContextualAlternates = 0
    End With
    With ActiveDocument.Styles("STLF Ref").ParagraphFormat
        .LeftIndent = CentimetersToPoints(0)
        .RightIndent = CentimetersToPoints(0)
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceAtLeast
        .LineSpacing = 11
        .Alignment = wdAlignParagraphLeft
        .WidowControl = False
        .KeepWithNext = False
        .KeepTogether = False
        .PageBreakBefore = False
        .NoLineNumber = False
        .Hyphenation = True
        .FirstLineIndent = CentimetersToPoints(0)
        .OutlineLevel = wdOutlineLevelBodyText
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
        .LineUnitBefore = 0
        .LineUnitAfter = 0
        .MirrorIndents = False
        .TextboxTightWrap = wdTightNone
        .CollapsedByDefault = False
    End With
    ActiveDocument.Styles("STLF Ref").NoSpaceBetweenParagraphsOfSameStyle = _
        False
    ActiveDocument.Styles("STLF Ref").ParagraphFormat.TabStops.ClearAll
    ActiveDocument.Styles("STLF Ref").ParagraphFormat.TabStops.Add Position:= _
        CentimetersToPoints(2.5), Alignment:=wdAlignTabLeft, Leader:= _
        wdTabLeaderSpaces
    With ActiveDocument.Styles("STLF Ref")
        .AutomaticallyUpdate = False
        .BaseStyle = "Normal"
        .NextParagraphStyle = "STLF Ref"
    End With
  End Sub

Open in new window


The aim is to have the DMS devs export a batch of documents pertaining to one office location to the network folder I mentioned above.  
The document updater, opens the macro-enabled template and runs the macro which looks in "network location", modifies the formatting as per macro, saves the documents and (maybe even relocates them to a folder called "processed") displays a prompt of successful completion.

A bonus would be if the macro button was tweaked so that it ran iteration 1 and checked the document for a specific formatting style called "STLF Ref" and if exists, ran additional formatting changes, if not, proceed with other documents.   This would alleviate the need to run iteration 2 of the macro (which actually throws an error when a document doesn't contain "STLF Ref").

I know there's different levels to what I'm asking here but I'd be grateful for any help.

Thanks in advance
0
Comment
Question by:Reece Dodds
  • 3
  • 2
5 Comments
 
LVL 76

Accepted Solution

by:
GrahamSkan earned 500 total points
ID: 40486060
Do a Find and Replace on your code to change 'ActiveDocument' to 'doc'.

Change the first line to:
Sub SLF1(doc as Document)

Open in new window

Call it with this code:
Sub OpenFiles()

Dim strInFile As String
Dim strInfolder As String
Dim doc As Word.Document


strInfolder = "C:\MyFolder"
strInFile = Dir(strInfolder & "\*.doc*")

Do Until Len(strInFile) < 1
    Set doc = Documents.Open(strInfolder & "\" & strInFile)
    SLF1 doc
    doc.Close wdSaveChanges
    strInFile = Dir() ' gets next file name
Loop
End Sub

Open in new window


The "STLF Ref" change isn't in this version
0
 
LVL 76

Assisted Solution

by:GrahamSkan
GrahamSkan earned 500 total points
ID: 40486081
Here is a function to check for the style:
Function HasStyle(doc As Document, strStyleName As String) As Boolean
Dim sty As Style

For Each sty In doc.Styles
    If sty = strStyleName Then
        HasStyle = True
        Exit For
    End If
Next sty
End Function

Open in new window

This is your macro modifed to work with both of the other macros
Sub SLF1(doc As Document)
    With doc.Styles("Footer").Font
        .Name = "Open Sans Light"
        .Size = 7
        .Bold = False
        .Italic = False
        .Underline = wdUnderlineNone
        .UnderlineColor = wdColorAutomatic
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .Emboss = False
        .Shadow = False
        .Hidden = False
        .SmallCaps = False
        .AllCaps = False
        .Color = wdColorAutomatic
        .Engrave = False
        .Superscript = False
        .Subscript = False
        .Scaling = 100
        .Kerning = 0
        .Animation = wdAnimationNone
        .Ligatures = wdLigaturesNone
        .NumberSpacing = wdNumberSpacingDefault
        .NumberForm = wdNumberFormDefault
        .StylisticSet = wdStylisticSetDefault
        .ContextualAlternates = 0
    End With
    With doc.Styles("Footer").ParagraphFormat
        .LeftIndent = CentimetersToPoints(0)
        .RightIndent = CentimetersToPoints(0)
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceSingle
        .Alignment = wdAlignParagraphLeft
        .WidowControl = True
        .KeepWithNext = False
        .KeepTogether = False
        .PageBreakBefore = False
        .NoLineNumber = False
        .Hyphenation = True
        .FirstLineIndent = CentimetersToPoints(0)
        .OutlineLevel = wdOutlineLevelBodyText
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
        .LineUnitBefore = 0
        .LineUnitAfter = 0
        .MirrorIndents = False
        .TextboxTightWrap = wdTightNone
        .CollapsedByDefault = False
    End With
    doc.Styles("Footer").NoSpaceBetweenParagraphsOfSameStyle = _
        False
    doc.Styles("Footer").ParagraphFormat.TabStops.ClearAll
    With doc.Styles("Footer")
        .AutomaticallyUpdate = False
        .BaseStyle = "Normal"
        .NextParagraphStyle = "Footer"
    End With
    If HasStyle(doc, "STLF Ref") Then
        With doc.Styles("STLF Ref").Font
            .Name = "Arial"
            .Size = 8.5
            .Bold = False
            .Italic = False
            .Underline = wdUnderlineNone
            .UnderlineColor = wdColorAutomatic
            .StrikeThrough = False
            .DoubleStrikeThrough = False
            .Outline = False
            .Emboss = False
            .Shadow = False
            .Hidden = False
            .SmallCaps = False
            .AllCaps = False
            .Color = wdColorAutomatic
            .Engrave = False
            .Superscript = False
            .Subscript = False
            .Scaling = 100
            .Kerning = 0
            .Animation = wdAnimationNone
            .Ligatures = wdLigaturesNone
            .NumberSpacing = wdNumberSpacingDefault
            .NumberForm = wdNumberFormDefault
            .StylisticSet = wdStylisticSetDefault
            .ContextualAlternates = 0
        End With
        With doc.Styles("STLF Ref").ParagraphFormat
            .LeftIndent = CentimetersToPoints(0)
            .RightIndent = CentimetersToPoints(0)
            .SpaceBefore = 0
            .SpaceBeforeAuto = False
            .SpaceAfter = 0
            .SpaceAfterAuto = False
            .LineSpacingRule = wdLineSpaceAtLeast
            .LineSpacing = 11
            .Alignment = wdAlignParagraphLeft
            .WidowControl = False
            .KeepWithNext = False
            .KeepTogether = False
            .PageBreakBefore = False
            .NoLineNumber = False
            .Hyphenation = True
            .FirstLineIndent = CentimetersToPoints(0)
            .OutlineLevel = wdOutlineLevelBodyText
            .CharacterUnitLeftIndent = 0
            .CharacterUnitRightIndent = 0
            .CharacterUnitFirstLineIndent = 0
            .LineUnitBefore = 0
            .LineUnitAfter = 0
            .MirrorIndents = False
            .TextboxTightWrap = wdTightNone
            .CollapsedByDefault = False
        End With
        doc.Styles("STLF Ref").NoSpaceBetweenParagraphsOfSameStyle = _
            False
        doc.Styles("STLF Ref").ParagraphFormat.TabStops.ClearAll
        doc.Styles("STLF Ref").ParagraphFormat.TabStops.Add Position:= _
            CentimetersToPoints(2.5), Alignment:=wdAlignTabLeft, Leader:= _
            wdTabLeaderSpaces
        With doc.Styles("STLF Ref")
            .AutomaticallyUpdate = False
            .BaseStyle = "Normal"
            .NextParagraphStyle = "STLF Ref"
        End With
    End If
  End Sub

Open in new window

0
 
LVL 7

Author Comment

by:Reece Dodds
ID: 40486144
Damn you're good.   So far it's working great.
Haven't tested the style check function yet.

I've read that you can make pretty complex macros that have prompts and the like...  Is there a way to have it prompt you with a dialogue box with input capability for the directory location (the part that goes between the "" so that we can just copy paste the folder path) and also output as a dialogue box how many documents were successfully updated?
0
 
LVL 76

Assisted Solution

by:GrahamSkan
GrahamSkan earned 500 total points
ID: 40486445
You can use this code to allow a user to select the folder:
Function PickFolder() As String
    Dim fd As FileDialog
    
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        If .Show = -1 Then
            If .SelectedItems.Count > 0 Then
                PickFolder = .SelectedItems(1)
            End If
        End If
    End With

End Function

Open in new window


You will have to Modify the OpenFile procedure:
Sub OpenFiles()

Dim strInFile As String
Dim strInfolder As String
Dim doc As Word.Document


strInfolder = PickFolder() '<-- changed here
strInFile = Dir(strInfolder & "\*.doc*")

Do Until Len(strInFile) < 1
    Set doc = Documents.Open(strInfolder & "\" & strInFile)
    SLF1 doc
    doc.Close wdSaveChanges
    strInFile = Dir() ' gets next file name
Loop
End Sub

Open in new window

0
 
LVL 7

Author Comment

by:Reece Dodds
ID: 40487824
perfect.  thanks.
0

Featured Post

Enterprise Mobility and BYOD For Dummies

Like “For Dummies” books, you can read this in whatever order you choose and learn about mobility and BYOD; and how to put a competitive mobile infrastructure in place. Developed for SMBs and large enterprises alike, you will find helpful use cases, planning, and implementation.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

As with any other System Center product, the installation for the Authoring Tool can be quite a pain sometimes. This article serves to help you avoid making these mistakes and hopefully save you a ton of time on troubleshooting :)  Step 1: Make sur…
Technology opened people to different means of presenting information, but PowerPoint remains to be above competition. Know why PPT still works today.
This video walks the viewer through the process of creating envelopes and labels, with multiple names and addresses. Navigate to the “Start Mail Merge” button in the Mailings tab: Follow the step-by-step process until asked to find the address doc…
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…

773 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question