Hi
Just putting the entire code here, hope someone will give an answer
Sub TallyDataInDataBase()
'Extract data from document form fields and store in Access database
Dim oPath As String
Dim FileArray() As String
Dim oFileName As String
Dim i As Long
'Requires reference to MS ActiveX Data Objects 2.8 Library
Dim vConnection As New ADODB.Connection
Dim vRecordSet As New ADODB.Recordset
Dim myDoc As Word.Document
Dim FiletoKill As String
'Call function to get path to saved forms
oPath = GetPathToUse
If oPath = "" Then
MsgBox "A folder was not selected"
Exit Sub
End If
'Call function to create a processed forms folder
CreateProcessedDirectory oPath
'Identify files names
oFileName = Dir$(oPath & "*.doc")
ReDim FileArray(1 To 10000) 'User a number larger the expected number of files to process
'Add file name to the array
Do While oFileName <> ""
i = i + 1
FileArray(i) = oFileName
'Get the next file name
oFileName = Dir$
Loop
If i = 0 Then
MsgBox "The selected folder did not contain any forms to process."
Exit Sub
End If
'Resize and preserve the array
ReDim Preserve FileArray(1 To i)
Application.ScreenUpdating = False
'Provide connection string.
vConnection.ConnectionString = "data source=D:\Batch\Tally Data Forms\Tally Data.mdb;" & _
"Provider=Microsoft.Jet.OLEDB.4.0;"
'NOTE if using an ".accdb" format data base use the following connection string:
'vConnection.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source=D:\Batch\Tally Data Forms\Tally Data.accdb;"
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("Name").Result <> "" Then _
vRecordSet("Participant Name") = .FormFields("Name").Result
If .FormFields("FavFood").Result <> "" Then _
vRecordSet("Favorite Food") = .FormFields("FavFood").Result
If .FormFields("FavColor").Result <> "" Then _
vRecordSet("Favorite Color") = .FormFields("FavColor").Result
.SaveAs oPath & "Processed\" & .Name 'Save processed file in Processed folder
.Close
Kill FiletoKill 'File as been saved in the processed file folder. Delete it 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
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = "Select Folder containing the completed form documents to and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
GetPathToUse = ""
Set fDialog = Nothing
Exit Function
End If
GetPathToUse = fDialog.SelectedItems.Item(1)
If Right(GetPathToUse, 1) <> "\" Then GetPathToUse = GetPathToUse + "\"
End With
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
