Batch re-naming

twols26 · #1 06-15-2015, 09:11 AM

How would you revise this macro in order to search for "Policy _________"? Would you be able to search within document and essentially copy and paste "Policy _________" to save as new document name? I actually tried to use a macro (copied below) however I am getting a Runtime error 4198 for .SaveAs FileName:=FirstPara & ".doc".

Help, please

Sub FirstPara()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
Dim FirstPara As String
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
FirstPara = .Paragraphs(1).Range.Text
FirstPara = Left(FirstPara, Len(FirstPara) - 1)
.SaveAs FileName:=FirstPara & ".doc"
.Close
End With
Set wdDoc = Nothing
strFile = Dir()
Wend
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

macropod · #2 06-15-2015, 04:48 PM

I've split your post from https://www.msofficeforums.com/word-...oned-body.html to a new thread, as the issue is quite different.

Do you not know where in the document the "Policy _________" string occurs? The code in your post assumes you want the text from the first paragraph in the document. It could just as easily be pointed to any other paragraph. Also, what, exactly, does the paragraph containing the "Policy _________" string contain? If it contains any characters that are illegal for a filename, those characters must be removed before you try saving the file.

twols26 · #3 06-16-2015, 04:09 AM

I'm trying to do is rename a batch of 200+ files as above by pulling the policy number following the word "Policy" found in the document. I'm wondering if I can reference it to a particular line of information in the word document, and how I would do so? I had tried using a macro where it renamed the document with the first line of information on the page, and I simply added a mail merge line (in white font) as the first line so that it would pull this information, but not show in print. Unfortunately it did not work... and am wondering if my first idea might work better. Can anybody help me create a macro where I take a particular line (and tell me how I should reference to a particular point)?

Letter looks like this:

Date

Address 1
Address 2
Address 3
Address 4

Policy XXXXXXXXX

<Body>

Policy number can change in # of characters depending on the type of plan code it is; so I'm not sure how to search something like that with parameters (which is why I'm wondering how to pull an entire line of information to rename the documents within a particular folder).

I also don't want a macro that creates a duplicate file (resulting in two of the same document with different names - as I have read within threads this can cause problems with loop).

Big thanks in advance!

gmayor · #4 06-16-2015, 05:15 AM

If this is a document from a mail merge, it might make more sense to re-merge it using http://www.gmayor.com/individual_merge_letters.htm or http://www.gmayor.com/MergeAndSplit.htm however, if not, and based on your original macro you need the following. Note that this creates the renamed documents in the same folder and does not delete the originals. You could save the documents in a different folder by modifying the SaveAs line.

Code:

Sub NameFiles()
    Application.ScreenUpdating = False
    Dim strFolder As String, strFile As String, wdDoc As Document
    Dim oPara As Paragraph
    Dim oRng As Range
    Dim strText As String
    Dim bFound As Boolean
    strFolder = GetFolder
    If strFolder = "" Then Exit Sub
    strFile = Dir(strFolder & "\*.doc", vbNormal)
    While strFile <> ""
        Set wdDoc = Documents.Open(Filename:=strFolder & "\" & strFile, _
                                   AddToRecentFiles:=False, _
                                   Visible:=False)
        With wdDoc
            For Each oPara In .Paragraphs
                If Trim(oPara.Range.Words(1)) = "Policy" Then
                    Set oRng = oPara.Range
                    oRng.End = oRng.End - 1
                    strText = Trim(Replace(oRng.Text, "Policy", ""))
                    .SaveAs Filename:=strText & ".doc"
                    bFound = True
                    .Close
                    Exit For
                End If
            Next oPara
            If Not bFound Then .Close 0
        End With
        Set wdDoc = Nothing
        strFile = Dir()
    Wend
    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

macropod · #5 06-16-2015, 05:39 AM

Quote:

Originally Posted by twols26

Letter looks like this:

Date

Address 1
Address 2
Address 3
Address 4

Policy XXXXXXXXX

<Body>

In that case, if the document is formatted correctly, the policy # should always be in the 3rd paragraph. Hence, it's just a matter of getting the text from that paragraph and stripping off anything illegal/irrelevant for the naming.

twols26 · #6 06-16-2015, 05:43 AM

Thanks! This sounds like a great solution. I ran the macro, however it isn't working for me. It appears to be going through the "loop", but none of my files are being renamed. Here is a sample file below.

Sample.doc

[quote=gmayor;84233]If this is a document from a mail merge, it might make more sense to re-merge it using http://www.gmayor.com/individual_merge_letters.htm or http://www.gmayor.com/MergeAndSplit.htm however, if not, and based on your original macro you need the following. Note that this creates the renamed documents in the same folder and does not delete the originals. You could save the documents in a different folder by modifying the SaveAs line.

macropod · #7 06-16-2015, 06:01 AM

OK, so you have a badly-formatted document, with paragraph breaks instead of line breaks between consecutive lines, and yet more paragraph breaks for inter-paragraph spacing, along with pointless tabs!

Given that scenario, you could use something like:

Code:

Sub PolicyDocs()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, StrName As String, wdDoc As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
  If Not strFile Like "Policy[*].doc" Then
    StrName = ""
    Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      With .Range
        With .Find
          .ClearFormatting
          .Text = "Policy[!^13]{1,}"
          .MatchWildcards = True
          .Forward = True
          .Wrap = wdFindStop
          .Execute
        End With
        If .Find.Found Then StrName = .Text
      End With
      If StrName <> "" Then .SaveAs FileName:=.Path & "\" & StrName & ".doc"
      .Close
    End With
  End If
  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

twols26 · #8 06-16-2015, 12:29 PM

Thank you both!

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Naming Cells for formula referencing	lynchbro	Excel	6	06-26-2014 07:45 AM
Naming plot-line breaks dates on x-axis	Sammael	Excel	0	06-01-2013 03:29 PM
re-naming arrays in VBA?	JDevsFan	Excel Programming	4	03-15-2012 08:44 AM
Auto file naming	Rong Peng	Word VBA	0	07-29-2011 07:37 AM
Auto-File Naming/ Default Directory Saves	sgill32	Word	2	11-06-2008 02:12 PM