CODEWITHSUNDEEP
vbams-word
user1440061
user1440061

Reputation: 445

Loop through all Word Files in Directory

I have the following code:

Sub WordtoTxtwLB()
'
' WordtoTxtwLB Macro
'
'
Dim fileName As String
myFileName = ActiveDocument.Name

ActiveDocument.SaveAs2 fileName:= _
"\\FILE\" & myFileName & ".txt", FileFormat:= _
wdFormatText, LockComments:=False, Password:="", AddToRecentFiles:=True, _
WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False, Encoding:=1252, InsertLineBreaks:=True, AllowSubstitutions:=False, _
LineEnding:=wdCRLF, CompatibilityMode:=0


End Sub

I want to loop this sub through all of the word (.doc) files in a directory. I have the following code:

Sub LoopDirectory()

vDirectory = "C:\programs2\test"

vFile = Dir(vDirectory & "\" & "*.*")

Do While vFile <> ""

Documents.Open fileName:=vDirectory & "\" & vFile

ActiveDocument.WordtoTxtwLB

vFile = Dir
Loop

End Sub

But it is not working. How do I get this to work either by altering the current code or using new code?

Upvotes: 6

Views: 45029

Answers (3)

Siddharth Rout
Siddharth Rout

Reputation: 149277

You don't actually need the WordtoTxtwLB Macro. You can combine both the codes. see this example

Sub LoopDirectory()
    Dim vDirectory As String
    Dim oDoc As Document
    
    vDirectory = "C:\programs2\test\"

    vFile = Dir(vDirectory & "*.*")

    Do While vFile <> ""
        Set oDoc = Documents.Open(fileName:=vDirectory & vFile)
        
        ActiveDocument.SaveAs2 fileName:="\\FILE\" & oDoc.Name & ".txt", _
                               FileFormat:=wdFormatText, _
                               LockComments:=False, _
                               Password:="", _
                               AddToRecentFiles:=True, _
                               WritePassword:="", _
                               ReadOnlyRecommended:=False, _
                               EmbedTrueTypeFonts:=False, _
                               SaveNativePictureFormat:=False, _
                               SaveFormsData:=False, _
                               SaveAsAOCELetter:=False, _
                               Encoding:=1252, _
                               InsertLineBreaks:=True, _
                               AllowSubstitutions:=False, _
                               LineEnding:=wdCRLF, _
                               CompatibilityMode:=0

        oDoc.Close SaveChanges:=False
        vFile = Dir
    Loop
End Sub

BTW, are you sure you want to use the *.* wildcard? What if there are Autocad files in the folder? Also ActiveDocument.Name will give you the file name with the Extension.

Upvotes: 15

William Tong
William Tong

Reputation: 475

Here's my solution. I think it's easy to understand and straight forward for newbies like me that I will post my code here. Because I searched around and the codes I saw were kind of complicated. Let's go.

Sub loopDocxs()
Dim wApp As Word.Application 
Dim wDoc As Word.Document 
Dim mySource As Object
Set obj = CreateObject("Scripting.FileSystemObject")
Set mySource = obj.GetFolder("D:\docxs\")

For Each file In mySource.Files 'loop through the directory
  If Len(file.Name) > 0 And InStr(1, file.Name, "$") = 0 Then '$ is temp file mask

    Set wApp = CreateObject("Word.Application")
    wApp.Visible = True
    'Word.Application doesn't recognize file here event if it's a word file.
    'fortunately we have the file name which we can use.
    Set wDoc = wApp.Documents.Open(mySource & "\" & file.Name, , ReadOnly)

    'Do your things here which will be a lot of code

    wApp.Quit
    Set wApp = Nothing


  End If
Next file

Upvotes: 0

mycowan
mycowan

Reputation: 1013

To edit all the word documents in a directory I built this simple subroutine.

The subRoutine loops through the directory and opens each *.doc file it finds. Then on the open document file it calls the second subRoutine. After the second subRoutine is finished the document is saved and then closed.

Sub DoVBRoutineNow()
Dim file
Dim path As String


path = "C:\Documents and Settings\userName\My Documents\myWorkFolder\"

file = Dir(path & "*.doc")
Do While file <> ""
Documents.Open FileName:=path & file

Call secondSubRoutine

ActiveDocument.Save
ActiveDocument.Close

file = Dir()
Loop
End Sub

~~~~~~

Upvotes: 2

Related Questions