INTELLIGENT WORK FORUMS FOR COMPUTER PROFESSIONALS
Contact US
Thanks. We have received your request and will respond promptly.
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
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 Selection.WholeStory Selection.Copy Documents.Add Template:="Normal", NewTemplate:=False Selection.Paste '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 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 ActiveWindow.Close strFullPathDoc = Dir ' Get next entry. Loop 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) Wend 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
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:
Talk To Other Members
Notification Of Responses To Questions
Favorite Forums One Click Access
Keyword Search Of All Posts, And More...
Register now while it's still free!
Already a member? Close this window and log in.
Join Us Close