Edit many files with VBA RRS feed

  • Question

  • Hi, Thanks for taking the time to read my question.

    I have many Word files (.doc, .docx) that have product codes in them; 1 or 2 per file. I have a translation table in Excel, and I'd like to use it to update the codes currently in the Word files.

    Eg: File1.doc has code 123. It needs to be updated to 987.

    I have a table in Excel that has:

    Old New
    456 654
    753 951
    123 987


    I'd like to have a macro that looks for all Word files in a folder. It would open the first one it found, then look for 456, then 753, then 123. Once at 123 it should find an instance of 123 in File1.doc and update it to 987, then save the edited file as a new name.

    I need to update the current files as there are 100's and each one has special formatting (colors, font etc). It would take many hours for someone to edit them, or create them from scratch.

    I guess I just don't know where to write the macro (Word or Excel) and I don't know the best place to have the transfer table. I'm also open to MS Access.

    Thanks for your help.


    Wednesday, April 9, 2014 11:12 PM


  • Try:

    Sub BulkFindReplace()
    Application.ScreenUpdating = True
    Dim strFolder As String, strFile As String, wdDoc As Document
    Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String
    Dim bStrt As Boolean, iDataRow As Long, bFound As Boolean
    Dim xlFList As String, xlRList As String, i As Long, Rslt
    StrWkBkNm = "C:\Users\" & Environ("Username") & "\Documents\Workbook Name.xls"
    StrWkSht = "Sheet1"
    If Dir(StrWkBkNm) = "" Then
      MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
      Exit Sub
    End If
    'Get the folder to process
    strFolder = GetFolder
    If strFolder = "" Then Exit Sub
    strFile = Dir(strFolder & "\*.doc", vbNormal)
    ' Test whether Excel is already running.
    On Error Resume Next
    bStrt = False ' Flag to record if we start Excel, so we can close it later.
    Set xlApp = GetObject(, "Excel.Application")
    'Start Excel if it isn't running
    If xlApp Is Nothing Then
      Set xlApp = CreateObject("Excel.Application")
      If xlApp Is Nothing Then
        MsgBox "Can't start Excel.", vbExclamation
        Exit Sub
      End If
      ' Record that we've started Excel.
      bStrt = True
    End If
    On Error GoTo 0
    'Check if the workbook is open.
    bFound = False
    With xlApp
      'Hide our Excel session
      If bStrt = True Then .Visible = False
      For Each xlWkBk In .Workbooks
        If xlWkBk.FullName = StrWkBkNm Then ' It's open
          Set xlWkBk = xlWkBk
          bFound = True
          Exit For
        End If
      ' If not open by the current user.
      If bFound = False Then
        ' Check if another user has it open.
        If IsFileLocked(StrWkBkNm) = True Then
          ' Report and exit if true
          MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
          If bStrt = True Then .Quit
          Exit Sub
        End If
        ' The file is available, so open it.
        Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm)
        If xlWkBk Is Nothing Then
          MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
          If bStrt = True Then .Quit
          Exit Sub
        End If
      End If
      ' Process the workbook.
      With xlWkBk.Worksheets(StrWkSht)
        ' Find the last-used row in column A.
        ' Add 1 to get the next row for data-entry.
        iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
        ' Output the captured data.
        For i = 1 To iDataRow
          ' Skip over empty fields to preserve the underlying cell contents.
          If Trim(.Range("A" & i)) <> vbNullString Then
            xlFList = xlFList & "|" & Trim(.Range("A" & i))
            xlRList = xlRList & "|" & Trim(.Range("B" & i))
          End If
      End With
      If bFound = False Then xlWkBk.Close False
      If bStrt = True Then .Quit
    End With
    ' Release Excel object memory
    Set xlWkBk = Nothing: Set xlApp = Nothing
    'Process each document in the folder
    While strFile <> ""
      Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
      'Process each word from the F/R List
      For i = 1 To UBound(Split(xlFList, "|"))
        With wdDoc.Range
          With .Find
            .MatchWholeWord = True
            .MatchCase = True
            .Wrap = wdFindStop
            .Text = Split(xlFList, "|")(i)
            .Replacement.Text = Split(xlRList, "|")(i)
            .Execute Replace:=wdReplaceAll
          End With
        End With
      'Close the document
      wdDoc.Close SaveChanges:=True
      'Get the next document
      strFile = Dir()
    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
    Function IsFileLocked(strFileName As String) As Boolean
      On Error Resume Next
      Open strFileName For Binary Access Read Write Lock Read Write As #1
      Close #1
      IsFileLocked = Err.Number
    End Function

    Note: The macro includes its own folder browser, so all you need do is brows to the document folder and let the macro process all files there. Don't save the file containing the above code to that folder, though, or it may close itself before finishing. As coded, the macro looks for an Excel workbook named 'Workbook Name.xls' in your 'Documents' folder. You may need to change those details in 'StrWkBkNm =' and the worksheet name in 'StrWkSht ='

    You also mention saving "the edited file as a new name", but it's not clear what that name would be. You seem to suggest using the replaced value, but what about when there is more than one replaced value?

    Paul Edstein
    [MS MVP - Word]

    Thursday, April 10, 2014 12:38 AM