CODEWITHSUNDEEP
vbams-word
ranopano
ranopano

Reputation: 539

VBA macro that reads a Word document and then saves the document based on text in file?

I have about 700 different Word documents that need to be renamed based off a text string. The format of each of the words docs are exactly the same.

In the word doc, there is a string of text that says "Your establishment name 0001 - Reno, NV". Each of the 700 documents contain a different location name.

I need a VBA Macro that can scan each of these word docs to find that text string and then save the document according to whatever the location is. So in this instance, the document should be saved as: 0001 - Reno, NV.docx

My code so far is:

Sub Macro1()
Dim strFilename As String
Dim rngNum As Range
Dim fd As FileDialog
Dim strFolder As String
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
    .Title = "Select the folder that contains the documents."
    If .Show = -1 Then
        strFolder = .SelectedItems(1) & "\"
    Else
        MsgBox "You did not select the folder that contains the documents."
        Exit Sub
    End If
End With
MkDir strFolder & "Processed"
strDoc = Dir$(strFolder & "*.docx")
While strDoc <> ""
    Set Doc = Documents.Open(strFolder & strDoc)
    With Doc
        Selection.HomeKey wdStory
        Selection.Find.ClearFormatting
        With Selection.Find
            Do While .Execute(FindText:="Your establishment name [0-9]{4}", MatchWildcards:=True, Forward:=True, Wrap:=wdFindStop) = True
                With Selection
                    Set rngNum = .Range
                    strFilename = Right(.Range.Text, 4)
                End With
            Loop
        End With
        .SaveAs strFolder & "Processed\" & strFilename
    End With
    strDoc = Dir$()
Wend
End Sub

This code, at least in theory, has you select the folder in which all of the 700 docs exist and then creates a new folder named "Processed" where all of the new, renamed documents are then placed.

However, when I run the code, I receive this error:

Run time error '5152':
This is not a valid file name.
Try one or more of the following:
*Check the path to make sure it was typed correctly.
*Select a file from the list of files and folders.

Upvotes: 1

Views: 3524

Answers (1)

TheSilkCode
TheSilkCode

Reputation: 366

I modified your code slightly while I was testing it to make it easier to read, wasn't exactly sure where your errors were coming from but the following code worked for me:

Sub Macro1()
Dim strFolder As String
Dim strDoc As String
Dim wordApp As Word.Application
Dim wordDoc As Word.document

Set wordApp = New Word.Application
wordApp.Visible = True

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
    .Title = "Select the folder that contains the documents."
    If .Show = -1 Then
        strFolder = .SelectedItems(1) & "\"
    Else
        MsgBox "You did not select the folder that contains the documents."
        Exit Sub
    End If
End With

MkDir strFolder & "Processed"

strDoc = Dir$(strFolder & "*.docx")
While strDoc <> ""
    Set wordDoc = Word.Documents.Open(strFolder & strDoc)
    With wordDoc
        .Content.Select
        With wordApp.Selection.Find
            .Text = "Your establishment name [0-9]{4}"
            .MatchWildcards = True
            .wrap = wdFindStop
            .Execute
        End With
        .SaveAs strFolder & "Processed\" & Right(wordApp.Selection, 4) & ".docx"
        .Close
    End With
    strDoc = Dir$()
Wend

wordApp.Quit
Set wordApp = Nothing
End Sub

Hope this helps, TheSilkCode

Upvotes: 1

Related Questions