Data from Word 2010 to Excel 2010

[birth19]

Hi,

I have recently just used this macro for my excel spreadsheet to pull data from all 50+ forms within my "Engineer Forms" folder.

For some reason I am receiving a Error 53 : File not found message.

It is pulling the data from one document in my folder but not the rest.

Can someone please assist me on this???


Sub Log_Docs()

Dim WdApp As Object, WdDoc As Object, blnAppOpen As Boolean, strDocName As String
Dim lngWriteRow As Long, strDir As String

blnAppOpen = True
strDir = "P:\Engineer Forms\"

If MsgBox("Data will be retrieved from all Word documents in this folder:" & vbCrLf & vbCrLf & _
strDir & vbCrLf & vbCrLf & "Do you want to continue?", vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If

' Look for first word document
strDocName = Dir(strDir & "*.doc")

' If no word document found then exit
If strDocName = "" Then
MsgBox "No files found!", vbCritical
Exit Sub
End If


On Error GoTo ErrorHandler
' Get open instance of word application if available
Set WdApp = GetObject(, "Word.Application")


Do While strDocName <> ""

' Open word document
Set WdDoc = WdApp.Documents.Open(strDir & strDocName)

With Sheets("TI_Information")
' Find last completed row on reporting log
lngWriteRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1

' Populate worksheet
.Range("A" & lngWriteRow).Value = WdDoc.FormFields("FldSiteID").Result
.Range("B" & lngWriteRow).Value = WdDoc.FormFields("FldDate").Result
.Range("C" & lngWriteRow).Value = WdDoc.FormFields("Fldname").Result
.Range("D" & lngWriteRow).Value = WdDoc.FormFields("Fldsname").Result
.Range("E" & lngWriteRow).Value = WdDoc.FormFields("Fldtype").Result
.Range("F" & lngWriteRow).Value = WdDoc.FormFields("Fldresult").Result
.Range("G" & lngWriteRow).Value = WdDoc.FormFields("Fldkit").Result
.Range("H" & lngWriteRow).Value = WdDoc.FormFields("Fldstatus").Result
.Range("I" & lngWriteRow).Value = WdDoc.FormFields("Fldref").Result
.Range("J" & lngWriteRow).Value = WdDoc.FormFields("Fldbt").Result
.Range("K" & lngWriteRow).Value = WdDoc.FormFields("Fldmc").Result
.Range("L" & lngWriteRow).Value = WdDoc.FormFields("Fldlate").Result
.Range("M" & lngWriteRow).Value = WdDoc.FormFields("Fldmiss").Result
.Range("N" & lngWriteRow).Value = WdDoc.FormFields("Flddelay").Result
.Range("O" & lngWriteRow).Value = strDocName
.Range("P" & lngWriteRow).Value = Now

End With

' Close word document and move to Logged folder
WdDoc.Close SaveChanges:=False
Name strDir & strDocName As strDir & "Logged/" & strDocName

' Look for next word document
strDocName = Dir

Loop

Set WdDoc = Nothing
If blnAppOpen = False Then
WdApp.Quit
Set WdApp = Nothing
End If

Exit Sub

' Error Handler
ErrorHandler:
If Err.Number = 429 Then
'Word is not running, open Word with CreateObject
Set WdApp = CreateObject("Word.Application")
blnAppOpen = False
Resume Next
Else
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
End If

End Sub

[mrice]

Try

Please Login or Register  to view this content.

and maybe moving the files to their new location as a separate step at the end or even reading all the filenames into an array before processing.

[snb]

Please wrap your code in codetags... (see the forum rules)