Results 1 to 15 of 15
  1. #1
    2 Star Lounger Jimmy-W's Avatar
    Join Date
    Jan 2001
    Location
    Helena, Montana, USA
    Posts
    194
    Thanks
    8
    Thanked 0 Times in 0 Posts

    Module help - editing all files in a folder

    I found the following macro and have tried to run it on a folder. It's supposed to call another macro named insert_tags, which will search/replace/insert text in a file. The module below quits at the ActiveDocument.Close command and also will stop at each one thereafter. My aim is to effect each edit in every file in the folder. Once edited, the module should save/close each file. Thanks.
    Code:
    Sub Traverse()
       Dim file
       Dim path As String
    
    ' Path to your folder. MY folder is listed below. I bet yours is different.
    ' make SURE you include the terminating "\"
    'YOU MUST EDIT THIS.
        path = "F:\CASES\!DOE\work\HTML Export 2014-01-21_15-48-54\Webpages\Fragments\"
    
    'Change this file extension to the file you are opening. .htm is listed below. You may have rtf or docx.
    'YOU MUST EDIT THIS.
       file = Dir(path & "*.json")
    
       Do While file <> ""
           Documents.Open FileName:=path & file
    
    ' This is the call to the macro you want to run on each file the folder
    'YOU MUST EDIT THIS. lange01 is my macro name. You put yours here.
          Call insert_tags
    
    ' Saves the file
         ActiveDocument.Save
         ActiveDocument.Close
    ' set file to next in Dir
         file = Dir()
      Loop
    
    End Sub
    Last edited by RetiredGeek; 2014-01-21 at 19:20. Reason: Added Code Tags
    JimmyW
    Helena, MT

  2. Subscribe to our Windows Secrets Newsletter - It's Free!

    Get our unique weekly Newsletter with tips and techniques, how to's and critical updates on Windows 7, Windows 8, Windows XP, Firefox, Internet Explorer, Google, etc. Join our 480,000 subscribers!

    Excel 2013: The Missing Manual

    + Get this BONUS — free!

    Get the most of Excel! Learn about new features, basics of creating a new spreadsheet and using the infamous Ribbon in the first chapter of Excel 2013: The Missing Manual - Subscribe and download Chapter 1 for free!

  3. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    5,801
    Thanks
    185
    Thanked 699 Times in 637 Posts
    Jimmy,

    The code is basically sound. I made a few adjustments, mostly stylistic, and ran a test and it worked fine.
    Code:
    Option Explicit
    
    Sub Traverse()
       Dim zFile As String
       Dim zPath As String
    
       zPath = "G:\BEKDocs\Word\Letters\"   '*** Path to Your Documents ***
    
    'Change this File extension to the File you are opening. .htm is listed below. You may have rtf or docx.
    'YOU MUST EDIT THIS.
       zFile = Dir(zPath & "*.doc")
    
       Do While zFile <> ""
         Documents.Open FileName:=zPath & zFile
         Call ListFile                       'Call processing routine (EDIT THIS!)
         Application.DisplayAlerts = False   'Prevent Overwrite Warnings
         ActiveDocument.Save                 'Save the File
         Application.DisplayAlerts = True    'Reset
         ActiveDocument.Close                'Close the document
         zFile = Dir()                       'Set File to next file in the path
       Loop
    
    End Sub
    
    Sub ListFile()
    
       Debug.Print ActiveDocument.Name
       
    End Sub
    Results in the Debug Window:

    Dilbert Letter Head.doc
    FAMILY GROUP SHEET.doc
    Hold Mail Letter to DEE.doc
    Janet's 2003 Roth IRA Contribution.doc
    RESUME.doc
    Secret Guide to Computers Order History & Letter.doc


    Note: Make sure you paste the code into a NEW document and save it as a type .DOCM in a Trusted Location.
    HTH
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  4. #3
    2 Star Lounger Jimmy-W's Avatar
    Join Date
    Jan 2001
    Location
    Helena, Montana, USA
    Posts
    194
    Thanks
    8
    Thanked 0 Times in 0 Posts
    Thanks very much. I replaced the code as you suggested. The only change is in the line where I called my macro:
    Call insert_tags 'Call processing routine (EDIT THIS!)

    When I run the module it stops at that line and the debugger opens. If I Shift+F8 through the rest, it completes and edits the target files in my indicated path.
    JimmyW
    Helena, MT

  5. #4
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    5,801
    Thanks
    185
    Thanked 699 Times in 637 Posts
    Jimmy,

    Could you post your code and your revised version of the posted code?

    Also where is your called routine located?
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  6. #5
    Silver Lounger Charles Kenyon's Avatar
    Join Date
    Jan 2001
    Location
    Madison, Wisconsin, Wisconsin, USA
    Posts
    1,652
    Thanks
    47
    Thanked 57 Times in 55 Posts
    Charles Kyle Kenyon
    Madison, Wisconsin

  7. #6
    2 Star Lounger Jimmy-W's Avatar
    Join Date
    Jan 2001
    Location
    Helena, Montana, USA
    Posts
    194
    Thanks
    8
    Thanked 0 Times in 0 Posts
    Thanks. First, I'm not a power user of macros and VBA. The macros are stored in Normal.dot. The code is below, and I also attached a screenshot. I simply found the original code at http://www.biblesupport.com/topic/16...s-in-a-folder/ and made the required edits. The code below is the cleaned up version that RetiredGeek suggested. I am trying to run it on multiple json files.

    Code:
    'You can name this whatever you want. DoLangesNow happens to be the name of this macro.
    'You will run this macro name...
    
    Option Explicit
    
    Sub Traverse()
       Dim zFile As String
       Dim zPath As String
    
       zPath = "c:\aaa\"   '*** Path to Your Documents ***
    
    'Change this File extension to the File you are opening. .htm is listed below. You may have rtf or docx.
    'YOU MUST EDIT THIS.
       zFile = Dir(zPath & "*.json")
    
       Do While zFile <> ""
         Documents.Open FileName:=zPath & zFile
         Call insert_tags                       'Call processing routine (EDIT THIS!)
         Application.DisplayAlerts = False   'Prevent Overwrite Warnings
         ActiveDocument.Save                 'Save the File
         Application.DisplayAlerts = True    'Reset
         ActiveDocument.Close                'Close the document
         zFile = Dir()                       'Set File to next file in the path
       Loop
    
    End Sub
    Attached Images Attached Images
    JimmyW
    Helena, MT

  8. #7
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,771
    Thanks
    0
    Thanked 162 Times in 150 Posts
    Hi Jimmy,

    The following macro allows you to browse to a folder containing the documents you want to process, then process all documents in that folder automatically.
    Code:
    Sub ProcessDocuments()
    Application.ScreenUpdating = False
    Dim strFolder As String, strFile As String, wdDoc as Document
    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
        'Do your processing here
        .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
    Where the line:
    'Do your processing here
    appears, you'd insert your processing code or the current call to it:
    Call insert_tags

    Note: you'd also need to change the file extension if you're not using Word documents - it seems you may be working with files whose extension is json.
    Last edited by macropod; 2014-01-23 at 17:34. Reason: Added note
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  9. #8
    2 Star Lounger Jimmy-W's Avatar
    Join Date
    Jan 2001
    Location
    Helena, Montana, USA
    Posts
    194
    Thanks
    8
    Thanked 0 Times in 0 Posts
    Thanks, Paul, but I'm afraid it didn't work. I posted the edited code below, but all that I did was change the extension to *.doc and add Call insert_tags. I changed the target file names to file.json.doc. The macro completed, but none of the files were edited. Instead, a new document was created with the inserted tags across the top, as in the screenshot. The same thing happened if I changed he target file names to file.doc.

    Code:
    Sub ProcessDocuments()
    Application.ScreenUpdating = False
    Dim strFolder As String, strFile As String, wdDoc As Document
    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
        'Do your processing here
        Call insert_tags
        .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
    Attached Images Attached Images
    JimmyW
    Helena, MT

  10. #9
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,771
    Thanks
    0
    Thanked 162 Times in 150 Posts
    Quote Originally Posted by Jimmy-W View Post
    I'm afraid it didn't work. I posted the edited code below, but all that I did was change the extension to *.doc and add Call insert_tags. I changed the target file names to file.json.doc. The macro completed, but none of the files were edited. Instead, a new document was created with the inserted tags across the top, as in the screenshot. The same thing happened if I changed he target file names to file.doc.
    Changing file extensions wasn't what I meant - my advice was meant to be understood as changing the '.doc' reference in the code the '.json'.

    Nevertheless, having changed the file extensions to .doc I would have expected the code to work. That it didn't suggests the issue is with your 'insert_tags' routine, not with the code that calls it. If you can post that code, we may be able to make some progress.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  11. #10
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    5,801
    Thanks
    185
    Thanked 699 Times in 637 Posts
    Jimmy,

    Ok, I just ran this code:
    Code:
    Option Explicit
    
    Sub Traverse()
       Dim zFile As String
       Dim zPath As String
    
       zPath = "G:\BEKDocs\Word\Test\"   '*** Path to Your Documents ***
    
    'Change this File extension to the File you are opening. .htm is listed below. You may have rtf or docx.
    'YOU MUST EDIT THIS.
       zFile = Dir(zPath & "*.json")
    
       Do While zFile <> ""
         Documents.Open FileName:=zPath & zFile
         Call Insert_Tags                       'Call processing routine (EDIT THIS!)
         Application.DisplayAlerts = False   'Prevent Overwrite Warnings
         ActiveDocument.SaveAs2 FileName:=zFile
         Application.DisplayAlerts = True    'Reset
         ActiveDocument.Close                'Close the document
         zFile = Dir()                       'Set File to next file in the path
       Loop
    
    End Sub
    
    Sub Insert_Tags()
    
       Debug.Print ActiveDocument.Name
       With Selection
           .HomeKey Unit:=wdStory
           .TypeText Text:="<html>"
           .EndKey Unit:=wdStory
           .TypeText Text:="</html>"
       End With
       
    End Sub
    Against these two files:
    File 1:

    <Div>
    This is a test1
    </Div>

    File 2:

    <Div>
    This is a test2
    </Div>

    And it ran w/o error producing:
    File 1:

    <html><Div>
    This is a test1
    </Div></html>

    File 2:

    <html><Div>
    This is a test2
    </Div></html>

    Here is the Blank Word document with the macros: TraverseDirectory.docm

    HTH
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  12. #11
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,771
    Thanks
    0
    Thanked 162 Times in 150 Posts
    I see you're still working with Selections! Ughh. Try:
    Code:
    Sub Insert_Tags()
    With ActiveDocument.Range
      .InsertBefore "<html>"
      .InsertAfter "</html>"
    End With
    End Sub
    Even so, my preference would be to pass the document reference to the procedure as well, using:
    Code:
    Call Insert_Tags(wdDoc)
    ...
    Sub Insert_Tags(wdDoc As Document)
    With wdDoc.Range
      .InsertBefore "<html>"
      .InsertAfter "</html>"
    End With
    End Sub
    That way, one can guarantee which document gets processed even if some other process changes which is the ActiveDocument.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  13. #12
    2 Star Lounger Jimmy-W's Avatar
    Join Date
    Jan 2001
    Location
    Helena, Montana, USA
    Posts
    194
    Thanks
    8
    Thanked 0 Times in 0 Posts
    Thanks again. I have to be doing something wrong, but I ran the code from your docm, and no edits were made to the target files.

    Code:
    Option Explicit
    
    Sub Traverse()
       Dim zFile As String
       Dim zPath As String
    
       zPath = "C:\aaa\New folder"   '*** Path to Your Documents ***
    
    'Change this File extension to the File you are opening. .htm is listed below. You may have rtf or docx.
    'YOU MUST EDIT THIS.
       zFile = Dir(zPath & "*.docx")
    
       Do While zFile <> ""
         Documents.Open FileName:=zPath & zFile
         Call Insert_Tags                       'Call processing routine (EDIT THIS!)
         Application.DisplayAlerts = False   'Prevent Overwrite Warnings
         ActiveDocument.SaveAs2 FileName:=zFile
         Application.DisplayAlerts = True    'Reset
         ActiveDocument.Close                'Close the document
         zFile = Dir()                       'Set File to next file in the path
       Loop
    
    End Sub
    
    Sub Insert_Tags()
    
       Debug.Print ActiveDocument.Name
       With Selection
           .HomeKey Unit:=wdStory
           .TypeText Text:="<html>"
           .EndKey Unit:=wdStory
           .TypeText Text:="</html>"
       End With
       
    End Sub
    JimmyW
    Helena, MT

  14. #13
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    5,801
    Thanks
    185
    Thanked 699 Times in 637 Posts
    Jimmy,

    You didn't include the closing \ in your path. This is required. See above.
    Should have been: zPath = "C:\aaa\New folder\" '*** Path to Your Documents *** HTH

    BTW: If it still doesn't work try it with a folder w/o a space in the name. If that works I may need to adjust the code.
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  15. #14
    2 Star Lounger Jimmy-W's Avatar
    Join Date
    Jan 2001
    Location
    Helena, Montana, USA
    Posts
    194
    Thanks
    8
    Thanked 0 Times in 0 Posts
    Thanks, and sorry that I missed that. I edited the path, too. Still, however, no joy. The target files are unchanged.

    Code:
    Option Explicit
    
    Sub Traverse()
       Dim zFile As String
       Dim zPath As String
    
       zPath = "c:\aaa\new_folder\"   '*** Path to Your Documents ***
    
    'Change this File extension to the File you are opening. .htm is listed below. You may have rtf or docx.
    'YOU MUST EDIT THIS.
       zFile = Dir(zPath & "*.docx")
    
       Do While zFile <> ""
         Documents.Open FileName:=zPath & zFile
         Call Insert_Tags                       'Call processing routine (EDIT THIS!)
         Application.DisplayAlerts = False   'Prevent Overwrite Warnings
         ActiveDocument.SaveAs2 FileName:=zFile
         Application.DisplayAlerts = True    'Reset
         ActiveDocument.Close                'Close the document
         zFile = Dir()                       'Set File to next file in the path
       Loop
    
    End Sub
    
    Sub Insert_Tags()
    
       Debug.Print ActiveDocument.Name
       With Selection
           .HomeKey Unit:=wdStory
           .TypeText Text:="<html>"
           .EndKey Unit:=wdStory
           .TypeText Text:="</html>"
       End With
       
    End Sub
    JimmyW
    Helena, MT

  16. #15
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,771
    Thanks
    0
    Thanked 162 Times in 150 Posts
    Perhaps I'm missing something, but I can't see the logic of:
    Code:
         Application.DisplayAlerts = False   'Prevent Overwrite Warnings
         ActiveDocument.SaveAs2 FileName:=zFile
         Application.DisplayAlerts = True    'Reset
    After all, all you're doing is re-saving the files with their original names in their original folders. Try:
    Code:
    Sub ProcessDocuments()
    Application.ScreenUpdating = False
    Dim strFolder As String, strFile As String, wdDoc as Document
    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
        Call Insert_Tags(wdDoc)
        .Close SaveChanges:=True
      End With
      strFile = Dir()
    Wend
    Set wdDoc = Nothing
    Application.ScreenUpdating = True
    End Sub
    
    Sub Insert_Tags(wdDoc As Document)
    With wdDoc.Range
      .InsertBefore "<html>"
      .InsertAfter "</html>"
    End With
    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
    As before, change the .doc reference in 'strFile = Dir(strFolder & "\*.doc", vbNormal)' to whatever file type you're working with.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •