Solved

MS Word macro to run on all documents within a directory

Posted on 2014-12-07
5
488 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Many companies are making the switch from Microsoft to Google Apps (https://www.google.com/work/apps/business/). Use this article to learn more about what Google Apps has to offer and to help if you’re planning on migrating to Google Apps. It is …
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Learn how to make your own table of contents in Microsoft Word using paragraph styles and the automatic table of contents tool. We'll be using the paragraph styles in Word’s Home toolbar to help you create a table of contents. Type out your initial …
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …

920 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now