Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Microsoft: Office FAQ

VB for apps

Loop Through All Word Documents in Directory by GeekGirlau
Posted: 30 Oct 01

You can loop through all the *.doc files in a directory with this macro. This example was used to recover corrupted documents. The code opens the file, selects the whole document and copies it, pastes to a new document, and saves the file with the original name, but in a new directory. However by changing the highlighted section in the middle, you can perform any action on all the nominated documents.

Sub LoopThruFile()
    Dim strPath As String
    Dim strNewPath As String
    Dim strFullPathDoc As String
    Dim strFileName As String
    strPath = "F:\Data\TestFolder\"
    strNewPath = strPath & "Recovered\"
    strFullPathDoc = Dir(strPath & "*.doc", vbNormal)

    Do While strFullPathDoc <> ""
        strFileName = ExtractFileName(strFullPathDoc)
        Documents.Open strPath & strFileName
        ' Change this section to perform a different action

        Documents.Add Template:="Normal", NewTemplate:=False
        ' Depending on what you're doing, you may want to use Save rather than SaveAs
        ' use this option to save to a different location

        ActiveDocument.SaveAs strNewPath & strFileName
        strFullPathDoc = Dir    ' Get next entry.
End Sub

Function ExtractFileName(strFullPath As String)
    Dim txt As String

    On Error Resume Next

    txt = "" & strFullPath

    While InStr(txt, "\") > 0
        txt = Mid$(txt, InStr(txt, "\") + 1)

    If InStr(txt, ":") > 0 Then
        txt = Mid$(txt, InStr(txt, ":") + 1)
    End If

    ExtractFileName = txt
End Function

Back to Microsoft: Office FAQ Index
Back to Microsoft: Office Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close