R
ryguy7272
Has anyone here used this tool?
http://gregmaxey.mvps.org/Extract_Form_Data.htm
I think the code should be run through Access, not Word. Whenever I try to
run the macro in my own Word file, I keep getting an error on this line:
Dim vConnection As New ADODB.Connection
I added in the reference to ADO Ext. 2.8 for DDL and Security, so I'm not
sure what the problem is now.
I have installed references to Word and ADO, but I still get this message:
Compile Error:
Method or Data Member Not Found.
Than, the code fails on this line:
Application.ScreenUpdating = False
If I comment this out, as well as the Application.ScreenUpdating =True line,
the macro moves ahead and lets me drill down to the folder named ‘Batch’, but
I can’t see anything in the folder. There are three Word docs in there, but
I can’t see any in the ‘Copy’ window that opens. Finally, I get a message
stating that ‘A folder was not selected’. That part is pretty obvious. I
can’t figure out why I can’t see those three Word docs though. Can someone
offer some assistance?
I think this:
vRecordSet!Name = .FormFields("Text1").Result
Needs to be this:
vRecordSet("Name") = .FormFields("Text1").Result
I can’t figure out the rest of it.
This is all of my code, which is inside an Access module:
Sub TallyData()
'Requires reference to MS ActiveX Data Objects 2.8 Library
Dim vConnection As New ADODB.Connection
Dim vRecordSet As New ADODB.Recordset
Dim oPath As String
Dim FileArray() As String
Dim oFileName As String
Dim i As Long
Dim myDoc As Word.Document
Dim FiletoKill As String
'Select the path containing the files to process
oPath = GetPathToUse
If oPath = "" Then
MsgBox "A folder was not selected"
Exit Sub
End If
'Create a subdirectory to store processed files if it doesn't exist.
CreateProcessedDirectory oPath
'Load file names into an array
oFileName = Dir$(oPath & "*.doc")
ReDim FileArray(1 To 1000) 'A number larger the expected number of replies
Do While oFileName <> ""
i = i + 1
FileArray(i) = oFileName
'Get the next file name
oFileName = Dir$
Loop
'Resize and preserve the array
ReDim Preserve FileArray(1 To i)
Application.ScreenUpdating = False
'Provide connection string for data using Jet Provider for Access database
vConnection.ConnectionString = "data source=C:\Batch\TestDataBase.mdb;" & _
"Provider=Microsoft.Jet.OLEDB.4.0;"
vConnection.Open
vRecordSet.Open "MyTable", vConnection, adOpenKeyset, adLockOptimistic
'Retrieve the data
vConnection.Execute "DELETE * FROM MyTable"
For i = 1 To UBound(FileArray)
Set myDoc = Documents.Open(FileName:=oPath & FileArray(i), _
Visible:=False)
FiletoKill = oPath & myDoc 'Identify the file to move after processing
vRecordSet.AddNew
With myDoc
If .FormFields("Text1").Result <> "" Then _
vRecordSet("Name") = .FormFields("Text1").Result
If .FormFields("Text2").Result <> "" Then _
vRecordSet("Favorite Food") = .FormFields("Text2").Result
If .FormFields("Text3").Result <> "" Then _
vRecordSet("Favorite Color") = .FormFields("Text3").Result
..SaveAs oPath & "Processed\" & .Name 'Save processed file in
Processed folder
..Close
Kill FiletoKill 'Delete file from the batch folder
End With
Next i
vRecordSet.Update
vRecordSet.Close
vConnection.Close
Set vRecordSet = Nothing
Set vConnection = Nothing
Application.ScreenUpdating = True
End Sub
Private Function GetPathToUse() As Variant
'Get the folder containing the files
'Note uses the "Copy Dialog" which enables the "open" option
With Dialogs(wdDialogCopyFile)
If .Display <> 0 Then
GetPathToUse = .Directory
Else
GetPathToUse = ""
Exit Function
End If
End With
If Left(GetPathToUse, 1) = Chr(34) Then
GetPathToUse = Mid(GetPathToUse, 2, Len(GetPathToUse) - 2)
End If
End Function
Sub CreateProcessedDirectory(oPath As String)
'Requires Reference to Microsoft Scripting Runtime
Dim Path As String
Dim FSO As FileSystemObject
Path = oPath
Dim NewDir As String
Set FSO = CreateObject("Scripting.FileSystemObject")
NewDir = Path & "Processed"
If Not FSO.FolderExists(NewDir) Then
FSO.CreateFolder NewDir
End If
End Sub
If anyone could tell me what i am doing wrong I would really appreciate it!!!
Regards,
Ryan---
http://gregmaxey.mvps.org/Extract_Form_Data.htm
I think the code should be run through Access, not Word. Whenever I try to
run the macro in my own Word file, I keep getting an error on this line:
Dim vConnection As New ADODB.Connection
I added in the reference to ADO Ext. 2.8 for DDL and Security, so I'm not
sure what the problem is now.
I have installed references to Word and ADO, but I still get this message:
Compile Error:
Method or Data Member Not Found.
Than, the code fails on this line:
Application.ScreenUpdating = False
If I comment this out, as well as the Application.ScreenUpdating =True line,
the macro moves ahead and lets me drill down to the folder named ‘Batch’, but
I can’t see anything in the folder. There are three Word docs in there, but
I can’t see any in the ‘Copy’ window that opens. Finally, I get a message
stating that ‘A folder was not selected’. That part is pretty obvious. I
can’t figure out why I can’t see those three Word docs though. Can someone
offer some assistance?
I think this:
vRecordSet!Name = .FormFields("Text1").Result
Needs to be this:
vRecordSet("Name") = .FormFields("Text1").Result
I can’t figure out the rest of it.
This is all of my code, which is inside an Access module:
Sub TallyData()
'Requires reference to MS ActiveX Data Objects 2.8 Library
Dim vConnection As New ADODB.Connection
Dim vRecordSet As New ADODB.Recordset
Dim oPath As String
Dim FileArray() As String
Dim oFileName As String
Dim i As Long
Dim myDoc As Word.Document
Dim FiletoKill As String
'Select the path containing the files to process
oPath = GetPathToUse
If oPath = "" Then
MsgBox "A folder was not selected"
Exit Sub
End If
'Create a subdirectory to store processed files if it doesn't exist.
CreateProcessedDirectory oPath
'Load file names into an array
oFileName = Dir$(oPath & "*.doc")
ReDim FileArray(1 To 1000) 'A number larger the expected number of replies
Do While oFileName <> ""
i = i + 1
FileArray(i) = oFileName
'Get the next file name
oFileName = Dir$
Loop
'Resize and preserve the array
ReDim Preserve FileArray(1 To i)
Application.ScreenUpdating = False
'Provide connection string for data using Jet Provider for Access database
vConnection.ConnectionString = "data source=C:\Batch\TestDataBase.mdb;" & _
"Provider=Microsoft.Jet.OLEDB.4.0;"
vConnection.Open
vRecordSet.Open "MyTable", vConnection, adOpenKeyset, adLockOptimistic
'Retrieve the data
vConnection.Execute "DELETE * FROM MyTable"
For i = 1 To UBound(FileArray)
Set myDoc = Documents.Open(FileName:=oPath & FileArray(i), _
Visible:=False)
FiletoKill = oPath & myDoc 'Identify the file to move after processing
vRecordSet.AddNew
With myDoc
If .FormFields("Text1").Result <> "" Then _
vRecordSet("Name") = .FormFields("Text1").Result
If .FormFields("Text2").Result <> "" Then _
vRecordSet("Favorite Food") = .FormFields("Text2").Result
If .FormFields("Text3").Result <> "" Then _
vRecordSet("Favorite Color") = .FormFields("Text3").Result
..SaveAs oPath & "Processed\" & .Name 'Save processed file in
Processed folder
..Close
Kill FiletoKill 'Delete file from the batch folder
End With
Next i
vRecordSet.Update
vRecordSet.Close
vConnection.Close
Set vRecordSet = Nothing
Set vConnection = Nothing
Application.ScreenUpdating = True
End Sub
Private Function GetPathToUse() As Variant
'Get the folder containing the files
'Note uses the "Copy Dialog" which enables the "open" option
With Dialogs(wdDialogCopyFile)
If .Display <> 0 Then
GetPathToUse = .Directory
Else
GetPathToUse = ""
Exit Function
End If
End With
If Left(GetPathToUse, 1) = Chr(34) Then
GetPathToUse = Mid(GetPathToUse, 2, Len(GetPathToUse) - 2)
End If
End Function
Sub CreateProcessedDirectory(oPath As String)
'Requires Reference to Microsoft Scripting Runtime
Dim Path As String
Dim FSO As FileSystemObject
Path = oPath
Dim NewDir As String
Set FSO = CreateObject("Scripting.FileSystemObject")
NewDir = Path & "Processed"
If Not FSO.FolderExists(NewDir) Then
FSO.CreateFolder NewDir
End If
End Sub
If anyone could tell me what i am doing wrong I would really appreciate it!!!
Regards,
Ryan---