Loop through all Word Files in Directory - vba

Question

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?

Answer 1

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.

Answer 2

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
~~~~~~

Answer 3

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