Run a macro on multiple documents

prakhil · #1 06-27-2014, 05:35 AM

Hi All,
Thanks for the superb code in https://www.msofficeforums.com/word-...ocx-files.html, though i am having some problem in running the same. There aren't any errors but there is something i am missing and not aware of.

i need you help to run this macro on 500 .docx files kept in a folder, below is the code:

Code:

Sub UpdateDocuments() 
    Application.ScreenUpdating = False 
    Dim strFolder As String, strFile As String, wdDoc As Document 
    Dim rng As Range 
    Dim docSourse As Document 
    strFolder = GetFolder 
    If strFolder = "" Then Exit Sub 
    strFile = Dir(strFolder & "\*.docx", vbNormal) 
    While strFile <> "" 
        Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False) 
        With wdDoc 
             'Call your other macro or insert its code here
             'Highlight all misspelled words.
             'Copy all misspelled words to new document.
            Set docSource = ActiveDocument 
            For Each rng In docSource.SpellingErrors 
                rng.Font.Color = wdColorRed 
                rng.Font.Bold = True 
            Next 
            .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

-----------------------------

on running this macro, i am getting an option to select the folder, i select the folder as well but the macro is running on just one file and not on all of the files. Please can you help me with this ?

macropod · #2 06-27-2014, 06:20 AM

There is nothing in the code to prevent it from running on multiple files. If it's only processing one, that suggests you have one or more files with some form of protection, or perhaps a mailmerge connection, in the same folder. The code isn't written to cope with such files.

You've evidently also added some code of your own without taking time to understand how it can be properly integrated with the code you found here. Try:

Code:

Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document, i As Long
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    'Highlight all misspelled words.
    For i = 1 To .SpellingErrors.Count
      With .SpellingErrors(i).Font
        .Color = wdColorRed
        .Bold = True
      End With
    Next
    .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

PS: When posting code, please use the code tags. They're on the 'Go Advanced' tab at the bottom of this screen.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Merge multiple word documents [Macro]	Arran [BMI]	Word	2	06-18-2018 08:21 PM
Macro to copy cell info to multiple documents	Patrick Innes	Word VBA	2	02-18-2015 08:38 PM
Updating multiple documents at once	1zillion	Word	1	08-28-2014 12:18 AM
Multiple page document to individual multiple page documents	Legger	Mail Merge	3	06-15-2014 06:36 AM
Macro for find/replace (including headers and footers) for multiple documents	jpb103	Word VBA	2	05-16-2014 04:59 AM