Excel VBA to open multiple Word files in a loop
I apologize in advance for the newbie question - most of my VBA experience is in Excel or Word in Excel. In this case, I am switching from Excel to Word. I am trying to grab some data from some Word forms and store it in an Excel file.
At the moment my code is working for the first document in the folder, but after that it hoses with an automation error "server threw an exception" (goo!)
Here is my code:
Dim objWordApp As Object
strCurFileName = Dir(strFilePath)
Set objWordApp = CreateObject("word.application")
objWordApp.Visible = True
Do While strCurFileName <> ""
objWordApp.documents.Open strFilePath & strCurFileName
objWordApp.activedocument.Unprotect password:="testcode"
{EXCEL PROCESSING HERE}
strCurFileName = Dir
objWordApp.activedocument.Close 0
Loop
objWordApp.Quit
Set objWordApp = Nothing
I notice that the code works fine if I exit the application and don't set object = nothing inside the loop. But as it is now, it runs the second file in the "objWordApp.documents.Open strFilePath and strCurFileName" folder.
Is it possible to open and close Word documents in a loop without creating the object over and over? It is very slow when I do this.
Thanks for the help. I like your way much better. Unfortunately I get the same result. The program dies a second time through the loop on the line that reads:
Set objWordDoc = objWordApp.Documents.Open(objFile.Path)
The error I am getting:
Runtime error -2147417851 (80010105) Automation error The server threw an exception.
I've tried my code on regular text documents (not the ones I'm processing) and it worked fine. The docs I'm running have form fields and macros - not sure if that matters. I have set the macro save in Word to both "low" and "very high" to make sure no other macros get in the way.
I just can't figure out why it works for the first document and then not the next. I even cloned the first document, but it didn't matter.
However, no luck. The only thing I can get to work is to completely erase the objects and re-create them every time I want to open the file.
Set objFolder = FSO.GetFolder(strFilePath)
For Each objFile In objFolder.Files
Set objWordApp = CreateObject("word.application")
objWordApp.Visible = True
If Right(objFile.Name, 4) = ".doc" Then
Set objWordDoc = objWordApp.documents.Open(Filename:=objFile.Path, ConfirmConversions:=False, _
ReadOnly:=True, AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto)
[Process DOC]
objWordDoc.Close 0, 1
End If
Set objWordDoc = Nothing
objWordApp.Quit
Set objWordApp = Nothing
Next
I'm not sure why this works and why it doesn't work differently. If I have to go this route I can - it seems very slow and inefficient. It is a bad idea?
I changed Dir to FileSystemObject (go to Tools \ References and Add Microsoft Scripting Runtime) and I was able to open multiple files successfully. If you have any problems, please describe the error you see in the debugger. Also, if you need to rewrite to subdirectories, you will need to refactor that.
Private mobjWordApp As Word.Application
Sub Test()
ProcessDirectory "PathName"
End Sub
Property Get WordApp() As Word.Application
If mobjWordApp Is Nothing Then
Set mobjWordApp = CreateObject("Word.Application")
mobjWordApp.Visible = True
End If
Set WordApp = mobjWordApp
End Property
Sub CloseWordApp()
If Not (mobjWordApp Is Nothing) Then
On Error Resume Next
mobjWordApp.Quit
Set mobjWordApp = Nothing
End If
End Sub
Function GetWordDocument(FileName As String) As Word.Document
On Error Resume Next
Set GetWordDocument = WordApp.Documents.Open(FileName)
If Err.Number = &H80010105 Then
CloseWordApp
On Error GoTo 0
Set GetWordDocument = WordApp.Documents.Open(FileName)
End If
End Function
Sub ProcessDirectory(PathName As String)
Dim fso As New FileSystemObject
Dim objFile As File
Dim objFolder As Folder
Dim objWordDoc As Object
On Error Goto Err_Handler
Set objFolder = fso.GetFolder(PathName)
For Each objFile In objFolder.Files
If StrComp(Right(objFile.Name, 4), ".doc", vbTextCompare) = 0 Then
Set objWordDoc = GetWordDocument(objFile.Path)
' objWordDoc.Unprotect Password:="testcode" ' Need to check if it has Password?
ProcessDocument objWordDoc
objWordDoc.Close 0, 1
Set objWordDoc = Nothing
End If
Next
Exit_Handler:
CloseWordApp
Exit Sub
Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Exit_Handler
'Resume Next ' or as above
End Sub
Sub ProcessDocument(objWordDoc As Document)
'{EXCEL PROCESSING HERE}'
End Sub
EDIT: I've added some error handling and a bit of refactoring, although there is still a bit more refactoring that could be done.
There must be something special about the documents you open. You can try different options for opening documents, for example:
Set objWordDoc = objWordApp.Documents.Open( _
FileName:=objFile.Path, ReadOnly:=True)
You may need to add Microsoft Word as a reference, and if you do, start using Word constants (wdDoNotSaveChanges, etc.). Check out the docs help. Open and check various options.
Also, use "Set Next Expression" from the context menu while debugging and maybe skip the first document and immediately open the second document and see if there are any problems.
EDIT: I changed the code to close and reopen Word in case you get the described automatic error. You may need to adjust the error numbers or just close Word on any error (if Err.Number <> 0 Then ...).
Again, there must be something special about your docs (macros, guards, etc.) because this code works in the test cases I've tried. Have you tried manually opening documents in Word in the same order as the script, updating information similar to your process script, and then closing the documents to see Word doing something strange?
Closing Word.Application will not hurt anything, but it will be noticeably much slower.
a source to share