Extract form field data to Access

E

Eric

I have used Greg Maxey's "Extract Formfield Data" macro fairly extensively
and I think I almost have is just perfect.

I am trying to use an (If, Then, Else,). If the formfield has data than
write it, if not, than go to the next formfield and check it for data etc. I
have many many form fields so the code would be reputitious. The macro hangs
if there is not data in the field identified or if the field does not exist.
I need it to skip if no data ....... or ........ if that field doen't exist.

Here is a snap shot of the reputitious portion of the macro and where it
hangs. What do I need to complete the If, Else etc.

If .FormFields("ReviewTitle").Result <> "" Then _
vRecordSet("ReviewTitle") = .FormFields("ReviewTitle").Result

If .FormFields("FHWAUnitOffice").Result <> "" Then _
vRecordSet("FHWAUnitOffice") = .FormFields("FHWAUnitOffice").Result

If .FormFields("ReviewTeamLeader").Result <> "" Then _
vRecordSet("ReviewTeamLeader") = .FormFields("ReviewTeamLeader").Result

If .FormFields("ProgramCategory").Result <> "" Then _
vRecordSet("ProgramCategory") = .FormFields("ProgramCategory").Result

Thanks for your helpful comments in advance.
 
D

Doug Robbins - Word MVP

Are you talking about the field not existing in the document or in the
Access table.

If it's the document, use

If .Bookmarks.Exists("ReviewTitle") Then
If .Formfields("ReviewTitle").Result <> "" Then
vRecordSet("ReviewTitle") = .FormFields("ReviewTitle").Result
End If
End If

If the names of your formfields (where they do exist are the same as the
names of the fields in the Access table, you could iterate through the
fields collection using:

For i = 1 to vRecordSet.Fields.Count
If .Bookmarks.Exists(vRecordSet.Fields(i - 1).Name) Then
If .FormFields(vRecordSet.Fields(i - 1).Name) <> "" Then
vRecordSet.Fields(i - 1) = .FormFields(vRecordSet.Fields(i -
1).Name).Result
End if
End If
Next i

and avoid all of the repitition.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP
 
E

Eric

Ok Doug I opted for the second option because if I used the 1st, the
"procedure was to large" because of the many fields. The second option is
sitll hanging at the 'XXXXX location indicated below. I must have somthing
wrong prior to your code. Can you take a look at this code and assist again?
Thanks

Sub Export()
'
' Macro created 6/19/2008 by Eric Berger
'
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

oPath = GetPathToUse
If oPath = "" Then
MsgBox "A folder was not selected. You need to select C:\My Reviews\"
Exit Sub
End If
CreateProcessedDirectory oPath
'Identify files names
oFileName = Dir$(oPath & "*.doc")
ReDim FileArray(1 To 1000) 'A number larger the expected number of replies
'Add file name to the array
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:\Review Tracker\Review
Tracker.mdb;" & _
"Provider=Microsoft.Jet.OLEDB.4.0;"
vConnection.Open
vRecordSet.Open "Review", vConnection, adOpenKeyset, adLockOptimistic
'Retrieve the data
'vConnection.Execute "DELETE * FROM Review"
'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

For i = 1 To vRecordSet.Fields.Count
If .Bookmarks.Exists(vRecordSet.Fields(i - 1).Name) Then
If .FormFields(vRecordSet.Fields(i - 1).Name) <> "" Then
'XXXXX- vRecordSet.Fields(i - 1) = .FormFields(vRecordSet.Fields(i -
1).Name).Result
End If
End If
Next i
.SaveAs oPath & "Processed\" & .Name 'Save processed file in Processed
folder
.Close
Kill FiletoKill 'Delete file from the batch folder
End With

vRecordSet.Update
vRecordSet.Close
vConnection.Close
Set vRecordSet = Nothing
Set vConnection = Nothing
Application.ScreenUpdating = True

End Sub
 
D

Doug Robbins - Word MVP

Sorry, that line of code should probably be

vRecordSet(vRecordSet.Fields(i - 1).Name) =
..FormFields(vRecordSet.Fields(i - 1).Name).Result

Stick a

MsgBox vRecordSet.Fields(i - 1).Name

in the code before that to check that it is returning the name of the field.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP
 
E

Eric

Sorry Doug its still hanging with a "Compile Error: Syntax Error.

Was there supposed to be (..)? Here is what I have.

For i = 1 To vRecordSet.Fields.Count
MsgBox vRecordSet.Fields(i - 1).Name

If .Bookmarks.Exists(vRecordSet.Fields(i - 1).Name) Then
If .FormFields(vRecordSet.Fields(i - 1).Name) <> "" Then
vRecordSet(vRecordSet.Fields(i - 1).Name)
=..FormFields(vRecordSet.Fields(i - 1).Name).Result
End If
End If
Next i


Thanks, we'll get there.
 
D

Doug Robbins - Word MVP

The should only be one . where you have two in

=..FormFields(vRecordSet.Fields(i - 1).Name).Result

What line of code is highlighted when the syntax error occurs?

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP
 
E

Eric

I think we're close.

I tried several differant variations. Here is what I have now and it errors
on the line shown below as XXXX.

I also did the MSG line you recommended and it starts checking the database
for fields and responds with only the first 5 and then stops when the line
hangs up. All FormFields in the Template have a matching field in the DBase.
It wants to complete, but has a problem somewhere.


Sub Export()
'
'
'
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

oPath = GetPathToUse
If oPath = "" Then
MsgBox "A folder was not selected. You need to select C:\My Reviews\"
Exit Sub
End If
CreateProcessedDirectory oPath
'Identify files names
oFileName = Dir$(oPath & "*.doc")
ReDim FileArray(1 To 1000) 'A number larger the expected number of replies
'Add file name to the array
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:\Review Tracker\Review
Tracker.mdb;" & _
"Provider=Microsoft.Jet.OLEDB.4.0;"
vConnection.Open
vRecordSet.Open "Review", vConnection, adOpenKeyset, adLockOptimistic
'Retrieve the data
'vConnection.Execute "DELETE * FROM Review"
'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

For i = 1 To vRecordSet.Fields.Count
MsgBox vRecordSet.Fields(i - 1).Name

If .Bookmarks.Exists(vRecordSet.Fields(i - 1).Name) Then
XXXX If .FormFields(vRecordSet.Fields(i - 1).Name) <> "" Then
vRecordSet(vRecordSet.Fields(i - 1).Name) =
..FormFields(vRecordSet.Fields(i - 1).Name).Result
End If
End If
Next i
.SaveAs oPath & "Processed\" & .Name 'Save processed file in Processed
folder
.Close
Kill FiletoKill 'Delete file from the batch folder
End With

vRecordSet.Update
vRecordSet.Close
vConnection.Close
Set vRecordSet = Nothing
Set vConnection = Nothing
Application.ScreenUpdating = True

End Sub
 
E

Eric

Doug, I have one other request for assistance that pertains to this same
code. In the code where it identifies the location of the Access Database,
is there a way to prompt the user for this location instead of having it hard
coded. and if so, where and what would it look like?

Thanks for all this help.... I might make my deadline with your help. :)
 
D

Doug Robbins - Word MVP

This line should be:

XXXX If .FormFields(vRecordSet.Fields(i - 1).Name).Result <> "" Then

without the XXXX of course

To allow the user to select the database, use

Dim dsource as string

With Dialogs(wdDialogFileOpen)
If .Display <> -1 Then
dsource = ""
Else
dsource = WordBasic.FileNameInfo$(.Name, 1)
End If
End With
' Make sure the user selected an Access database
If Right(dsource, 3) <> "mdb" Then
MsgBox "You did not select a valid file type (.mdb)."
Exit Sub
Else
dsource = dsource & ";"
End If

Then use:

vConnection.ConnectionString = "data source=" & dsource & _
"Provider=Microsoft.Jet.OLEDB.4.0;"


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP
 
E

Eric

Well that fixed the hangup, but now the data is not written to the Dbase. It
is cycling through each field. It is also opening the Dbase behind the
scenes. Everything appears to working except no data to Access.

Her is the code:

Sub Export()
'
'
'
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

oPath = GetPathToUse
If oPath = "" Then
MsgBox "A folder was not selected. You need to select C:\My Reviews\"
Exit Sub
End If
CreateProcessedDirectory oPath
'Identify files names
oFileName = Dir$(oPath & "*.doc")
ReDim FileArray(1 To 1000) 'A number larger the expected number of replies
'Add file name to the array
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:\Review Tracker\Review
Tracker.mdb;" & _
"Provider=Microsoft.Jet.OLEDB.4.0;"
vConnection.Open
vRecordSet.Open "Review", vConnection, adOpenKeyset, adLockOptimistic
'Retrieve the data
'vConnection.Execute "DELETE * FROM Review"
'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

For i = 1 To vRecordSet.Fields.Count
If .Bookmarks.Exists(vRecordSet.Fields(i - 1).Name) Then
If .FormFields(vRecordSet.Fields(i - 1).Name).Result <> "" Then
vRecordSet(vRecordSet.Fields(i - 1).Name) =
..FormFields(vRecordSet.Fields(i - 1).Name).Result
End If
End If
Next i
.SaveAs oPath & "Processed\" & .Name
'Save processed file in Processed Folder
.Close
Kill FiletoKill 'Delete file from the batch folder
End With

vRecordSet.Update
vRecordSet.Close
vConnection.Close
Set vRecordSet = Nothing
Set vConnection = Nothing
Application.ScreenUpdating = True

End Sub
 
E

Eric

I think th problem resides in these specific lines of code: Notice how I
commented out: 'vConnection.Execute "DELETE * FROM Review"
'For i = 1 To UBound(FileArray)

I did this because I didn't understand the "DELETE * FROM Review"

Also I had to add the new line for If Bookmarks exist etc. and this was
erroring out because of the double 'For i = 1 procedure.

But this is where I believe I'm all messed up.

vConnection.Open
vRecordSet.Open "Review", vConnection, adOpenKeyset, adLockOptimistic
'Retrieve the data
'vConnection.Execute "DELETE * FROM Review"
'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

For i = 1 To vRecordSet.Fields.Count
If .Bookmarks.Exists(vRecordSet.Fields(i - 1).Name) Then
If .FormFields(vRecordSet.Fields(i - 1).Name).Result <> "" Then
vRecordSet(vRecordSet.Fields(i - 1).Name) =
..FormFields(vRecordSet.Fields(i - 1).Name).Result
End If
End If
Next i
 
D

Doug Robbins - Word MVP

The: vConnection.Execute "DELETE * FROM Review" would delete all of the
records from the Review table

Without the For i = 1 To UBound(FileArray) the procedure is probably not
processing any files, though, there would need to have been a corresponding
Next i and you would then need to have replaced the i in the second For i =
loop to something else, say j so that the counters did not get mixed up.

Here is code that I successfully use to process all of the documents in a
folder - it requires that a reference be set to the Microsoft Shell Controls
and Automation object library as well as to that of the Microsoft ActiveX
Data Objects li:#.# Library.

Dim vConnection As New ADODB.Connection
Dim vRecordSet As New ADODB.Recordset
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder
Dim FldrPath As String
Dim RecordDoc As String
Dim Source As Document
Dim i As Long, j As Long
Dim FileToKill As String

'Get the folder where the forms have been saved.

Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Select folder that contains the returned
Forms", &H400)
If Not Fldr Is Nothing Then
FldrPath = Fldr.Items.Item.Path & "\"
End If
Set Fldr = Nothing
RecordDoc = Dir$(FldrPath & "*.doc")

vConnection.ConnectionString = _
"data source=c:\path\databasename.mdb;" & _
"Provider=Microsoft.Jet.OLEDB.4.0;"

vConnection.Open

vRecordSet.Open "tblSources", vConnection, adOpenKeyset, adLockOptimistic

i = 0
While RecordDoc <> ""
vRecordSet.AddNew
Set Source = Documents.Open(FldrPath & RecordDoc)
With Source
For j = 1 To vRecordSet.Fields.Count
If .Bookmarks.Exists(vRecordSet.Fields(j - 1).Name) Then
If .FormFields(vRecordSet.Fields(j - 1).Name).Result <> ""
Then
vRecordSet(vRecordSet.Fields(j - 1).Name) = _
.FormFields(vRecordSet.Fields(j - 1).Name).Result
End If
End If
Next j
End With
vRecordSet.Update
i = i + 1
FileToKill = Source.FullName
Source.SaveAs FldrPath & "Processed\" & Source.Name
Source.Close wdDoNotSaveChanges
Kill FileToKill
RecordDoc = Dir
Wend

MsgBox i & " Records Added."

vRecordSet.Close
vConnection.Close
Set vRecordSet = Nothing
Set vConnection = Nothing


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP
 
E

Eric

OK, Doug.... You're awesome! I am now using you code as provided and it
works great.... no issues.

I wanted to also incoorportate your code that allows the user to select the
Dbase and its location. I almost have it, I think I may be missing a
"Reference" that maybe you use etc. Its either that or I have the code in
the wrong order. Now the hanging line is on

vConnection.Open

I get an error saying:

[Microsoft][ODBC Driver Manager] Data source name not found and no default
driver specifed.

Your help has almost got me there.
 
D

Doug Robbins - Word MVP

Eric,

Show us the full code that you are now trying to use.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

Eric said:
OK, Doug.... You're awesome! I am now using you code as provided and it
works great.... no issues.

I wanted to also incoorportate your code that allows the user to select
the
Dbase and its location. I almost have it, I think I may be missing a
"Reference" that maybe you use etc. Its either that or I have the code in
the wrong order. Now the hanging line is on

vConnection.Open

I get an error saying:

[Microsoft][ODBC Driver Manager] Data source name not found and no default
driver specifed.

Your help has almost got me there.
--
Eric the Rookie


Doug Robbins - Word MVP said:
The: vConnection.Execute "DELETE * FROM Review" would delete all of the
records from the Review table

Without the For i = 1 To UBound(FileArray) the procedure is probably not
processing any files, though, there would need to have been a
corresponding
Next i and you would then need to have replaced the i in the second For i
=
loop to something else, say j so that the counters did not get mixed up.

Here is code that I successfully use to process all of the documents in a
folder - it requires that a reference be set to the Microsoft Shell
Controls
and Automation object library as well as to that of the Microsoft ActiveX
Data Objects li:#.# Library.

Dim vConnection As New ADODB.Connection
Dim vRecordSet As New ADODB.Recordset
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder
Dim FldrPath As String
Dim RecordDoc As String
Dim Source As Document
Dim i As Long, j As Long
Dim FileToKill As String

'Get the folder where the forms have been saved.

Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Select folder that contains the
returned
Forms", &H400)
If Not Fldr Is Nothing Then
FldrPath = Fldr.Items.Item.Path & "\"
End If
Set Fldr = Nothing
RecordDoc = Dir$(FldrPath & "*.doc")

vConnection.ConnectionString = _
"data source=c:\path\databasename.mdb;" & _
"Provider=Microsoft.Jet.OLEDB.4.0;"

vConnection.Open

vRecordSet.Open "tblSources", vConnection, adOpenKeyset, adLockOptimistic

i = 0
While RecordDoc <> ""
vRecordSet.AddNew
Set Source = Documents.Open(FldrPath & RecordDoc)
With Source
For j = 1 To vRecordSet.Fields.Count
If .Bookmarks.Exists(vRecordSet.Fields(j - 1).Name) Then
If .FormFields(vRecordSet.Fields(j - 1).Name).Result <>
""
Then
vRecordSet(vRecordSet.Fields(j - 1).Name) = _
.FormFields(vRecordSet.Fields(j - 1).Name).Result
End If
End If
Next j
End With
vRecordSet.Update
i = i + 1
FileToKill = Source.FullName
Source.SaveAs FldrPath & "Processed\" & Source.Name
Source.Close wdDoNotSaveChanges
Kill FileToKill
RecordDoc = Dir
Wend

MsgBox i & " Records Added."

vRecordSet.Close
vConnection.Close
Set vRecordSet = Nothing
Set vConnection = Nothing


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP
 
E

Eric

Here is the full code.... Thanks

Sub Export()
'
'
'
Dim vConnection As New ADODB.Connection
Dim vRecordSet As New ADODB.Recordset
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder
Dim FldrPath As String
Dim RecordDoc As String
Dim dsource As String
Dim Source As Document
Dim i As Long, j As Long
Dim FileToKill As String

'Get the folder where the forms have been saved.

Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Select the Directory (Folder) that
contains your Review Report", &H400)
If Not Fldr Is Nothing Then
FldrPath = Fldr.Items.Item.Path & "\"
End If
Set Fldr = Nothing
RecordDoc = Dir$(FldrPath & "*.doc")

vConnection.ConnectionString = "data source=" & dsource & _
"Provider=Microsoft.Jet.OLEDB.4.0;"

With Dialogs(wdDialogFileOpen)
If .Display <> -1 Then
dsource = ""
Else
dsource = WordBasic.FileNameInfo$(.Name, 1)
End If
End With
' Make sure the user selected an Access database
If Right(dsource, 3) <> "mdb" Then
MsgBox "You did not select a valid Access Database file type (.mdb) Review
Tracker."
Exit Sub
Else
dsource = dsource & ";"
End If

vConnection.Open

vRecordSet.Open "Review", vConnection, adOpenKeyset, adLockOptimistic

i = 0
While RecordDoc <> ""
vRecordSet.AddNew
Set Source = Documents.Open(FldrPath & RecordDoc)
With Source
For j = 1 To vRecordSet.Fields.Count
If .Bookmarks.Exists(vRecordSet.Fields(j - 1).Name) Then
If .FormFields(vRecordSet.Fields(j - 1).Name).Result <> ""
Then
vRecordSet(vRecordSet.Fields(j - 1).Name) = _
.FormFields(vRecordSet.Fields(j - 1).Name).Result
End If
End If
Next j
End With
vRecordSet.Update
i = i + 1
FileToKill = Source.FullName
Source.SaveAs FldrPath & "Processed\" & Source.Name
Source.Close wdDoNotSaveChanges
Kill FileToKill
RecordDoc = Dir
Wend

MsgBox i & " Records Added."

vRecordSet.Close
vConnection.Close
Set vRecordSet = Nothing
Set vConnection = Nothing

End Sub

--
Eric the Rookie


Doug Robbins - Word MVP said:
Eric,

Show us the full code that you are now trying to use.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

Eric said:
OK, Doug.... You're awesome! I am now using you code as provided and it
works great.... no issues.

I wanted to also incoorportate your code that allows the user to select
the
Dbase and its location. I almost have it, I think I may be missing a
"Reference" that maybe you use etc. Its either that or I have the code in
the wrong order. Now the hanging line is on

vConnection.Open

I get an error saying:

[Microsoft][ODBC Driver Manager] Data source name not found and no default
driver specifed.

Your help has almost got me there.
--
Eric the Rookie


Doug Robbins - Word MVP said:
The: vConnection.Execute "DELETE * FROM Review" would delete all of the
records from the Review table

Without the For i = 1 To UBound(FileArray) the procedure is probably not
processing any files, though, there would need to have been a
corresponding
Next i and you would then need to have replaced the i in the second For i
=
loop to something else, say j so that the counters did not get mixed up.

Here is code that I successfully use to process all of the documents in a
folder - it requires that a reference be set to the Microsoft Shell
Controls
and Automation object library as well as to that of the Microsoft ActiveX
Data Objects li:#.# Library.

Dim vConnection As New ADODB.Connection
Dim vRecordSet As New ADODB.Recordset
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder
Dim FldrPath As String
Dim RecordDoc As String
Dim Source As Document
Dim i As Long, j As Long
Dim FileToKill As String

'Get the folder where the forms have been saved.

Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Select folder that contains the
returned
Forms", &H400)
If Not Fldr Is Nothing Then
FldrPath = Fldr.Items.Item.Path & "\"
End If
Set Fldr = Nothing
RecordDoc = Dir$(FldrPath & "*.doc")

vConnection.ConnectionString = _
"data source=c:\path\databasename.mdb;" & _
"Provider=Microsoft.Jet.OLEDB.4.0;"

vConnection.Open

vRecordSet.Open "tblSources", vConnection, adOpenKeyset, adLockOptimistic

i = 0
While RecordDoc <> ""
vRecordSet.AddNew
Set Source = Documents.Open(FldrPath & RecordDoc)
With Source
For j = 1 To vRecordSet.Fields.Count
If .Bookmarks.Exists(vRecordSet.Fields(j - 1).Name) Then
If .FormFields(vRecordSet.Fields(j - 1).Name).Result <>
""
Then
vRecordSet(vRecordSet.Fields(j - 1).Name) = _
.FormFields(vRecordSet.Fields(j - 1).Name).Result
End If
End If
Next j
End With
vRecordSet.Update
i = i + 1
FileToKill = Source.FullName
Source.SaveAs FldrPath & "Processed\" & Source.Name
Source.Close wdDoNotSaveChanges
Kill FileToKill
RecordDoc = Dir
Wend

MsgBox i & " Records Added."

vRecordSet.Close
vConnection.Close
Set vRecordSet = Nothing
Set vConnection = Nothing


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

I think th problem resides in these specific lines of code: Notice how
I
commented out: 'vConnection.Execute "DELETE * FROM Review"
'For i = 1 To UBound(FileArray)

I did this because I didn't understand the "DELETE * FROM Review"

Also I had to add the new line for If Bookmarks exist etc. and this was
erroring out because of the double 'For i = 1 procedure.

But this is where I believe I'm all messed up.

vConnection.Open
vRecordSet.Open "Review", vConnection, adOpenKeyset, adLockOptimistic
'Retrieve the data
'vConnection.Execute "DELETE * FROM Review"
'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

For i = 1 To vRecordSet.Fields.Count
If .Bookmarks.Exists(vRecordSet.Fields(i - 1).Name) Then
If .FormFields(vRecordSet.Fields(i - 1).Name).Result <> "" Then
vRecordSet(vRecordSet.Fields(i - 1).Name) =
.FormFields(vRecordSet.Fields(i - 1).Name).Result
End If
End If
Next i
--
Eric the Rookie


:

Well that fixed the hangup, but now the data is not written to the
Dbase.
It
is cycling through each field. It is also opening the Dbase behind
the
scenes. Everything appears to working except no data to Access.

Her is the code:

Sub Export()
'
'
'
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

oPath = GetPathToUse
If oPath = "" Then
MsgBox "A folder was not selected. You need to select C:\My
Reviews\"
Exit Sub
End If
CreateProcessedDirectory oPath
'Identify files names
oFileName = Dir$(oPath & "*.doc")
ReDim FileArray(1 To 1000) 'A number larger the expected number of
replies
'Add file name to the array
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:\Review Tracker\Review
Tracker.mdb;" & _
"Provider=Microsoft.Jet.OLEDB.4.0;"
vConnection.Open
vRecordSet.Open "Review", vConnection, adOpenKeyset, adLockOptimistic
'Retrieve the data
'vConnection.Execute "DELETE * FROM Review"
'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

For i = 1 To vRecordSet.Fields.Count
If .Bookmarks.Exists(vRecordSet.Fields(i - 1).Name) Then
If .FormFields(vRecordSet.Fields(i - 1).Name).Result <> ""
Then
vRecordSet(vRecordSet.Fields(i - 1).Name) =
.FormFields(vRecordSet.Fields(i - 1).Name).Result
End If
End If
Next i
.SaveAs oPath & "Processed\" & .Name
'Save processed file in Processed Folder
.Close
Kill FiletoKill 'Delete file from the batch folder
End With

vRecordSet.Update
vRecordSet.Close
vConnection.Close
Set vRecordSet = Nothing
Set vConnection = Nothing
Application.ScreenUpdating = True

End Sub
--
Eric the Rookie


:

This line should be:

XXXX If .FormFields(vRecordSet.Fields(i - 1).Name).Result <> "" Then

without the XXXX of course

To allow the user to select the database, use

Dim dsource as string

With Dialogs(wdDialogFileOpen)
If .Display <> -1 Then
dsource = ""
Else
dsource = WordBasic.FileNameInfo$(.Name, 1)
End If
End With
' Make sure the user selected an Access database
If Right(dsource, 3) <> "mdb" Then
MsgBox "You did not select a valid file type (.mdb)."
Exit Sub
Else
dsource = dsource & ";"
End If

Then use:

vConnection.ConnectionString = "data source=" & dsource & _
"Provider=Microsoft.Jet.OLEDB.4.0;"


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of
my
services on a paid consulting basis.

Doug Robbins - Word MVP

I think we're close.

I tried several differant variations. Here is what I have now and
 
D

Doug Robbins - Word MVP

Try

Sub Export()
'
'
'
Dim vConnection As New ADODB.Connection
Dim vRecordSet As New ADODB.Recordset
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder
Dim FldrPath As String
Dim RecordDoc As String
Dim dsource As String
Dim Source As Document
Dim i As Long, j As Long
Dim FileToKill As String

'Get the folder where the forms have been saved.

Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Select the Directory (Folder) that
contains your Review Report", &H400)
If Not Fldr Is Nothing Then
FldrPath = Fldr.Items.Item.Path & "\"
End If
Set Fldr = Nothing
RecordDoc = Dir$(FldrPath & "*.doc")

With Dialogs(wdDialogFileOpen)
If .Display <> -1 Then
dsource = ""
Else
dsource = WordBasic.FileNameInfo$(.Name, 1)
End If
End With
' Make sure the user selected an Access database
If Right(dsource, 3) <> "mdb" Then
MsgBox "You did not select a valid Access Database file type (.mdb) Review
Tracker."
Exit Sub
Else
dsource = dsource & ";"
End If

vConnection.ConnectionString = "data source=" & dsource & _
"Provider=Microsoft.Jet.OLEDB.4.0;"

vConnection.Open

vRecordSet.Open "Review", vConnection, adOpenKeyset, adLockOptimistic

i = 0
While RecordDoc <> ""
vRecordSet.AddNew
Set Source = Documents.Open(FldrPath & RecordDoc)
With Source
For j = 1 To vRecordSet.Fields.Count
If .Bookmarks.Exists(vRecordSet.Fields(j - 1).Name) Then
If .FormFields(vRecordSet.Fields(j - 1).Name).Result <> ""
Then
vRecordSet(vRecordSet.Fields(j - 1).Name) = _
.FormFields(vRecordSet.Fields(j - 1).Name).Result
End If
End If
Next j
End With
vRecordSet.Update
i = i + 1
FileToKill = Source.FullName
Source.SaveAs FldrPath & "Processed\" & Source.Name
Source.Close wdDoNotSaveChanges
Kill FileToKill
RecordDoc = Dir
Wend

MsgBox i & " Records Added."

vRecordSet.Close
vConnection.Close
Set vRecordSet = Nothing
Set vConnection = Nothing

End Sub

You were setting the Connection String using a stringvariable that had not
yet been loaded with anything.
--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

Eric said:
Here is the full code.... Thanks

Sub Export()
'
'
'
Dim vConnection As New ADODB.Connection
Dim vRecordSet As New ADODB.Recordset
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder
Dim FldrPath As String
Dim RecordDoc As String
Dim dsource As String
Dim Source As Document
Dim i As Long, j As Long
Dim FileToKill As String

'Get the folder where the forms have been saved.

Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Select the Directory (Folder) that
contains your Review Report", &H400)
If Not Fldr Is Nothing Then
FldrPath = Fldr.Items.Item.Path & "\"
End If
Set Fldr = Nothing
RecordDoc = Dir$(FldrPath & "*.doc")

vConnection.ConnectionString = "data source=" & dsource & _
"Provider=Microsoft.Jet.OLEDB.4.0;"

With Dialogs(wdDialogFileOpen)
If .Display <> -1 Then
dsource = ""
Else
dsource = WordBasic.FileNameInfo$(.Name, 1)
End If
End With
' Make sure the user selected an Access database
If Right(dsource, 3) <> "mdb" Then
MsgBox "You did not select a valid Access Database file type (.mdb) Review
Tracker."
Exit Sub
Else
dsource = dsource & ";"
End If

vConnection.Open

vRecordSet.Open "Review", vConnection, adOpenKeyset, adLockOptimistic

i = 0
While RecordDoc <> ""
vRecordSet.AddNew
Set Source = Documents.Open(FldrPath & RecordDoc)
With Source
For j = 1 To vRecordSet.Fields.Count
If .Bookmarks.Exists(vRecordSet.Fields(j - 1).Name) Then
If .FormFields(vRecordSet.Fields(j - 1).Name).Result <> ""
Then
vRecordSet(vRecordSet.Fields(j - 1).Name) = _
.FormFields(vRecordSet.Fields(j - 1).Name).Result
End If
End If
Next j
End With
vRecordSet.Update
i = i + 1
FileToKill = Source.FullName
Source.SaveAs FldrPath & "Processed\" & Source.Name
Source.Close wdDoNotSaveChanges
Kill FileToKill
RecordDoc = Dir
Wend

MsgBox i & " Records Added."

vRecordSet.Close
vConnection.Close
Set vRecordSet = Nothing
Set vConnection = Nothing

End Sub

--
Eric the Rookie


Doug Robbins - Word MVP said:
Eric,

Show us the full code that you are now trying to use.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

Eric said:
OK, Doug.... You're awesome! I am now using you code as provided and
it
works great.... no issues.

I wanted to also incoorportate your code that allows the user to select
the
Dbase and its location. I almost have it, I think I may be missing a
"Reference" that maybe you use etc. Its either that or I have the code
in
the wrong order. Now the hanging line is on

vConnection.Open

I get an error saying:

[Microsoft][ODBC Driver Manager] Data source name not found and no
default
driver specifed.

Your help has almost got me there.
--
Eric the Rookie


:

The: vConnection.Execute "DELETE * FROM Review" would delete all of
the
records from the Review table

Without the For i = 1 To UBound(FileArray) the procedure is probably
not
processing any files, though, there would need to have been a
corresponding
Next i and you would then need to have replaced the i in the second
For i
=
loop to something else, say j so that the counters did not get mixed
up.

Here is code that I successfully use to process all of the documents
in a
folder - it requires that a reference be set to the Microsoft Shell
Controls
and Automation object library as well as to that of the Microsoft
ActiveX
Data Objects li:#.# Library.

Dim vConnection As New ADODB.Connection
Dim vRecordSet As New ADODB.Recordset
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder
Dim FldrPath As String
Dim RecordDoc As String
Dim Source As Document
Dim i As Long, j As Long
Dim FileToKill As String

'Get the folder where the forms have been saved.

Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Select folder that contains the
returned
Forms", &H400)
If Not Fldr Is Nothing Then
FldrPath = Fldr.Items.Item.Path & "\"
End If
Set Fldr = Nothing
RecordDoc = Dir$(FldrPath & "*.doc")

vConnection.ConnectionString = _
"data source=c:\path\databasename.mdb;" & _
"Provider=Microsoft.Jet.OLEDB.4.0;"

vConnection.Open

vRecordSet.Open "tblSources", vConnection, adOpenKeyset,
adLockOptimistic

i = 0
While RecordDoc <> ""
vRecordSet.AddNew
Set Source = Documents.Open(FldrPath & RecordDoc)
With Source
For j = 1 To vRecordSet.Fields.Count
If .Bookmarks.Exists(vRecordSet.Fields(j - 1).Name) Then
If .FormFields(vRecordSet.Fields(j - 1).Name).Result
<>
""
Then
vRecordSet(vRecordSet.Fields(j - 1).Name) = _
.FormFields(vRecordSet.Fields(j - 1).Name).Result
End If
End If
Next j
End With
vRecordSet.Update
i = i + 1
FileToKill = Source.FullName
Source.SaveAs FldrPath & "Processed\" & Source.Name
Source.Close wdDoNotSaveChanges
Kill FileToKill
RecordDoc = Dir
Wend

MsgBox i & " Records Added."

vRecordSet.Close
vConnection.Close
Set vRecordSet = Nothing
Set vConnection = Nothing


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

I think th problem resides in these specific lines of code: Notice
how
I
commented out: 'vConnection.Execute "DELETE * FROM Review"
'For i = 1 To UBound(FileArray)

I did this because I didn't understand the "DELETE * FROM Review"

Also I had to add the new line for If Bookmarks exist etc. and this
was
erroring out because of the double 'For i = 1 procedure.

But this is where I believe I'm all messed up.

vConnection.Open
vRecordSet.Open "Review", vConnection, adOpenKeyset,
adLockOptimistic
'Retrieve the data
'vConnection.Execute "DELETE * FROM Review"
'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

For i = 1 To vRecordSet.Fields.Count
If .Bookmarks.Exists(vRecordSet.Fields(i - 1).Name) Then
If .FormFields(vRecordSet.Fields(i - 1).Name).Result <> ""
Then
vRecordSet(vRecordSet.Fields(i - 1).Name) =
.FormFields(vRecordSet.Fields(i - 1).Name).Result
End If
End If
Next i
--
Eric the Rookie


:

Well that fixed the hangup, but now the data is not written to the
Dbase.
It
is cycling through each field. It is also opening the Dbase behind
the
scenes. Everything appears to working except no data to Access.

Her is the code:

Sub Export()
'
'
'
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

oPath = GetPathToUse
If oPath = "" Then
MsgBox "A folder was not selected. You need to select C:\My
Reviews\"
Exit Sub
End If
CreateProcessedDirectory oPath
'Identify files names
oFileName = Dir$(oPath & "*.doc")
ReDim FileArray(1 To 1000) 'A number larger the expected number of
replies
'Add file name to the array
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:\Review
Tracker\Review
Tracker.mdb;" & _
"Provider=Microsoft.Jet.OLEDB.4.0;"
vConnection.Open
vRecordSet.Open "Review", vConnection, adOpenKeyset,
adLockOptimistic
'Retrieve the data
'vConnection.Execute "DELETE * FROM Review"
'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

For i = 1 To vRecordSet.Fields.Count
If .Bookmarks.Exists(vRecordSet.Fields(i - 1).Name) Then
If .FormFields(vRecordSet.Fields(i - 1).Name).Result <> ""
Then
vRecordSet(vRecordSet.Fields(i - 1).Name) =
.FormFields(vRecordSet.Fields(i - 1).Name).Result
End If
End If
Next i
.SaveAs oPath & "Processed\" & .Name
'Save processed file in Processed Folder
.Close
Kill FiletoKill 'Delete file from the batch folder
End With

vRecordSet.Update
vRecordSet.Close
vConnection.Close
Set vRecordSet = Nothing
Set vConnection = Nothing
Application.ScreenUpdating = True

End Sub
--
Eric the Rookie


:

This line should be:

XXXX If .FormFields(vRecordSet.Fields(i - 1).Name).Result <> ""
Then

without the XXXX of course

To allow the user to select the database, use

Dim dsource as string

With Dialogs(wdDialogFileOpen)
If .Display <> -1 Then
dsource = ""
Else
dsource = WordBasic.FileNameInfo$(.Name, 1)
End If
End With
' Make sure the user selected an Access database
If Right(dsource, 3) <> "mdb" Then
MsgBox "You did not select a valid file type (.mdb)."
Exit Sub
Else
dsource = dsource & ";"
End If

Then use:

vConnection.ConnectionString = "data source=" & dsource & _

"Provider=Microsoft.Jet.OLEDB.4.0;"


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself
of
my
services on a paid consulting basis.

Doug Robbins - Word MVP

I think we're close.

I tried several differant variations. Here is what I have now
and
 
E

Eric

Thank You Sir! That works perfect. You and your MVP Team are outstanding!
I apprecieate your time with this one Doug. You came through big time...

Thanks
--
Eric the Rookie


Doug Robbins - Word MVP said:
Try

Sub Export()
'
'
'
Dim vConnection As New ADODB.Connection
Dim vRecordSet As New ADODB.Recordset
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder
Dim FldrPath As String
Dim RecordDoc As String
Dim dsource As String
Dim Source As Document
Dim i As Long, j As Long
Dim FileToKill As String

'Get the folder where the forms have been saved.

Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Select the Directory (Folder) that
contains your Review Report", &H400)
If Not Fldr Is Nothing Then
FldrPath = Fldr.Items.Item.Path & "\"
End If
Set Fldr = Nothing
RecordDoc = Dir$(FldrPath & "*.doc")

With Dialogs(wdDialogFileOpen)
If .Display <> -1 Then
dsource = ""
Else
dsource = WordBasic.FileNameInfo$(.Name, 1)
End If
End With
' Make sure the user selected an Access database
If Right(dsource, 3) <> "mdb" Then
MsgBox "You did not select a valid Access Database file type (.mdb) Review
Tracker."
Exit Sub
Else
dsource = dsource & ";"
End If

vConnection.ConnectionString = "data source=" & dsource & _
"Provider=Microsoft.Jet.OLEDB.4.0;"

vConnection.Open

vRecordSet.Open "Review", vConnection, adOpenKeyset, adLockOptimistic

i = 0
While RecordDoc <> ""
vRecordSet.AddNew
Set Source = Documents.Open(FldrPath & RecordDoc)
With Source
For j = 1 To vRecordSet.Fields.Count
If .Bookmarks.Exists(vRecordSet.Fields(j - 1).Name) Then
If .FormFields(vRecordSet.Fields(j - 1).Name).Result <> ""
Then
vRecordSet(vRecordSet.Fields(j - 1).Name) = _
.FormFields(vRecordSet.Fields(j - 1).Name).Result
End If
End If
Next j
End With
vRecordSet.Update
i = i + 1
FileToKill = Source.FullName
Source.SaveAs FldrPath & "Processed\" & Source.Name
Source.Close wdDoNotSaveChanges
Kill FileToKill
RecordDoc = Dir
Wend

MsgBox i & " Records Added."

vRecordSet.Close
vConnection.Close
Set vRecordSet = Nothing
Set vConnection = Nothing

End Sub

You were setting the Connection String using a stringvariable that had not
yet been loaded with anything.
--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

Eric said:
Here is the full code.... Thanks

Sub Export()
'
'
'
Dim vConnection As New ADODB.Connection
Dim vRecordSet As New ADODB.Recordset
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder
Dim FldrPath As String
Dim RecordDoc As String
Dim dsource As String
Dim Source As Document
Dim i As Long, j As Long
Dim FileToKill As String

'Get the folder where the forms have been saved.

Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Select the Directory (Folder) that
contains your Review Report", &H400)
If Not Fldr Is Nothing Then
FldrPath = Fldr.Items.Item.Path & "\"
End If
Set Fldr = Nothing
RecordDoc = Dir$(FldrPath & "*.doc")

vConnection.ConnectionString = "data source=" & dsource & _
"Provider=Microsoft.Jet.OLEDB.4.0;"

With Dialogs(wdDialogFileOpen)
If .Display <> -1 Then
dsource = ""
Else
dsource = WordBasic.FileNameInfo$(.Name, 1)
End If
End With
' Make sure the user selected an Access database
If Right(dsource, 3) <> "mdb" Then
MsgBox "You did not select a valid Access Database file type (.mdb) Review
Tracker."
Exit Sub
Else
dsource = dsource & ";"
End If

vConnection.Open

vRecordSet.Open "Review", vConnection, adOpenKeyset, adLockOptimistic

i = 0
While RecordDoc <> ""
vRecordSet.AddNew
Set Source = Documents.Open(FldrPath & RecordDoc)
With Source
For j = 1 To vRecordSet.Fields.Count
If .Bookmarks.Exists(vRecordSet.Fields(j - 1).Name) Then
If .FormFields(vRecordSet.Fields(j - 1).Name).Result <> ""
Then
vRecordSet(vRecordSet.Fields(j - 1).Name) = _
.FormFields(vRecordSet.Fields(j - 1).Name).Result
End If
End If
Next j
End With
vRecordSet.Update
i = i + 1
FileToKill = Source.FullName
Source.SaveAs FldrPath & "Processed\" & Source.Name
Source.Close wdDoNotSaveChanges
Kill FileToKill
RecordDoc = Dir
Wend

MsgBox i & " Records Added."

vRecordSet.Close
vConnection.Close
Set vRecordSet = Nothing
Set vConnection = Nothing

End Sub

--
Eric the Rookie


Doug Robbins - Word MVP said:
Eric,

Show us the full code that you are now trying to use.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

OK, Doug.... You're awesome! I am now using you code as provided and
it
works great.... no issues.

I wanted to also incoorportate your code that allows the user to select
the
Dbase and its location. I almost have it, I think I may be missing a
"Reference" that maybe you use etc. Its either that or I have the code
in
the wrong order. Now the hanging line is on

vConnection.Open

I get an error saying:

[Microsoft][ODBC Driver Manager] Data source name not found and no
default
driver specifed.

Your help has almost got me there.
--
Eric the Rookie


:

The: vConnection.Execute "DELETE * FROM Review" would delete all of
the
records from the Review table

Without the For i = 1 To UBound(FileArray) the procedure is probably
not
processing any files, though, there would need to have been a
corresponding
Next i and you would then need to have replaced the i in the second
For i
=
loop to something else, say j so that the counters did not get mixed
up.

Here is code that I successfully use to process all of the documents
in a
folder - it requires that a reference be set to the Microsoft Shell
Controls
and Automation object library as well as to that of the Microsoft
ActiveX
Data Objects li:#.# Library.

Dim vConnection As New ADODB.Connection
Dim vRecordSet As New ADODB.Recordset
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder
Dim FldrPath As String
Dim RecordDoc As String
Dim Source As Document
Dim i As Long, j As Long
Dim FileToKill As String

'Get the folder where the forms have been saved.

Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Select folder that contains the
returned
Forms", &H400)
If Not Fldr Is Nothing Then
FldrPath = Fldr.Items.Item.Path & "\"
End If
Set Fldr = Nothing
RecordDoc = Dir$(FldrPath & "*.doc")

vConnection.ConnectionString = _
"data source=c:\path\databasename.mdb;" & _
"Provider=Microsoft.Jet.OLEDB.4.0;"

vConnection.Open

vRecordSet.Open "tblSources", vConnection, adOpenKeyset,
adLockOptimistic

i = 0
While RecordDoc <> ""
vRecordSet.AddNew
Set Source = Documents.Open(FldrPath & RecordDoc)
With Source
For j = 1 To vRecordSet.Fields.Count
If .Bookmarks.Exists(vRecordSet.Fields(j - 1).Name) Then
If .FormFields(vRecordSet.Fields(j - 1).Name).Result
<>
""
Then
vRecordSet(vRecordSet.Fields(j - 1).Name) = _
.FormFields(vRecordSet.Fields(j - 1).Name).Result
End If
End If
Next j
End With
vRecordSet.Update
i = i + 1
FileToKill = Source.FullName
Source.SaveAs FldrPath & "Processed\" & Source.Name
 
D

Doug Robbins - Word MVP

Glad we got there in the end.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

Eric said:
Thank You Sir! That works perfect. You and your MVP Team are
outstanding!
I apprecieate your time with this one Doug. You came through big time...

Thanks
--
Eric the Rookie


Doug Robbins - Word MVP said:
Try

Sub Export()
'
'
'
Dim vConnection As New ADODB.Connection
Dim vRecordSet As New ADODB.Recordset
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder
Dim FldrPath As String
Dim RecordDoc As String
Dim dsource As String
Dim Source As Document
Dim i As Long, j As Long
Dim FileToKill As String

'Get the folder where the forms have been saved.

Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Select the Directory (Folder) that
contains your Review Report", &H400)
If Not Fldr Is Nothing Then
FldrPath = Fldr.Items.Item.Path & "\"
End If
Set Fldr = Nothing
RecordDoc = Dir$(FldrPath & "*.doc")

With Dialogs(wdDialogFileOpen)
If .Display <> -1 Then
dsource = ""
Else
dsource = WordBasic.FileNameInfo$(.Name, 1)
End If
End With
' Make sure the user selected an Access database
If Right(dsource, 3) <> "mdb" Then
MsgBox "You did not select a valid Access Database file type (.mdb)
Review
Tracker."
Exit Sub
Else
dsource = dsource & ";"
End If

vConnection.ConnectionString = "data source=" & dsource & _
"Provider=Microsoft.Jet.OLEDB.4.0;"

vConnection.Open

vRecordSet.Open "Review", vConnection, adOpenKeyset, adLockOptimistic

i = 0
While RecordDoc <> ""
vRecordSet.AddNew
Set Source = Documents.Open(FldrPath & RecordDoc)
With Source
For j = 1 To vRecordSet.Fields.Count
If .Bookmarks.Exists(vRecordSet.Fields(j - 1).Name) Then
If .FormFields(vRecordSet.Fields(j - 1).Name).Result <>
""
Then
vRecordSet(vRecordSet.Fields(j - 1).Name) = _
.FormFields(vRecordSet.Fields(j - 1).Name).Result
End If
End If
Next j
End With
vRecordSet.Update
i = i + 1
FileToKill = Source.FullName
Source.SaveAs FldrPath & "Processed\" & Source.Name
Source.Close wdDoNotSaveChanges
Kill FileToKill
RecordDoc = Dir
Wend

MsgBox i & " Records Added."

vRecordSet.Close
vConnection.Close
Set vRecordSet = Nothing
Set vConnection = Nothing

End Sub

You were setting the Connection String using a stringvariable that had
not
yet been loaded with anything.
--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

Eric said:
Here is the full code.... Thanks

Sub Export()
'
'
'
Dim vConnection As New ADODB.Connection
Dim vRecordSet As New ADODB.Recordset
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder
Dim FldrPath As String
Dim RecordDoc As String
Dim dsource As String
Dim Source As Document
Dim i As Long, j As Long
Dim FileToKill As String

'Get the folder where the forms have been saved.

Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Select the Directory (Folder) that
contains your Review Report", &H400)
If Not Fldr Is Nothing Then
FldrPath = Fldr.Items.Item.Path & "\"
End If
Set Fldr = Nothing
RecordDoc = Dir$(FldrPath & "*.doc")

vConnection.ConnectionString = "data source=" & dsource & _
"Provider=Microsoft.Jet.OLEDB.4.0;"

With Dialogs(wdDialogFileOpen)
If .Display <> -1 Then
dsource = ""
Else
dsource = WordBasic.FileNameInfo$(.Name, 1)
End If
End With
' Make sure the user selected an Access database
If Right(dsource, 3) <> "mdb" Then
MsgBox "You did not select a valid Access Database file type (.mdb)
Review
Tracker."
Exit Sub
Else
dsource = dsource & ";"
End If

vConnection.Open

vRecordSet.Open "Review", vConnection, adOpenKeyset, adLockOptimistic

i = 0
While RecordDoc <> ""
vRecordSet.AddNew
Set Source = Documents.Open(FldrPath & RecordDoc)
With Source
For j = 1 To vRecordSet.Fields.Count
If .Bookmarks.Exists(vRecordSet.Fields(j - 1).Name) Then
If .FormFields(vRecordSet.Fields(j - 1).Name).Result <>
""
Then
vRecordSet(vRecordSet.Fields(j - 1).Name) = _
.FormFields(vRecordSet.Fields(j - 1).Name).Result
End If
End If
Next j
End With
vRecordSet.Update
i = i + 1
FileToKill = Source.FullName
Source.SaveAs FldrPath & "Processed\" & Source.Name
Source.Close wdDoNotSaveChanges
Kill FileToKill
RecordDoc = Dir
Wend

MsgBox i & " Records Added."

vRecordSet.Close
vConnection.Close
Set vRecordSet = Nothing
Set vConnection = Nothing

End Sub

--
Eric the Rookie


:

Eric,

Show us the full code that you are now trying to use.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

OK, Doug.... You're awesome! I am now using you code as provided
and
it
works great.... no issues.

I wanted to also incoorportate your code that allows the user to
select
the
Dbase and its location. I almost have it, I think I may be missing
a
"Reference" that maybe you use etc. Its either that or I have the
code
in
the wrong order. Now the hanging line is on

vConnection.Open

I get an error saying:

[Microsoft][ODBC Driver Manager] Data source name not found and no
default
driver specifed.

Your help has almost got me there.
--
Eric the Rookie


:

The: vConnection.Execute "DELETE * FROM Review" would delete all
of
the
records from the Review table

Without the For i = 1 To UBound(FileArray) the procedure is
probably
not
processing any files, though, there would need to have been a
corresponding
Next i and you would then need to have replaced the i in the second
For i
=
loop to something else, say j so that the counters did not get
mixed
up.

Here is code that I successfully use to process all of the
documents
in a
folder - it requires that a reference be set to the Microsoft Shell
Controls
and Automation object library as well as to that of the Microsoft
ActiveX
Data Objects li:#.# Library.

Dim vConnection As New ADODB.Connection
Dim vRecordSet As New ADODB.Recordset
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder
Dim FldrPath As String
Dim RecordDoc As String
Dim Source As Document
Dim i As Long, j As Long
Dim FileToKill As String

'Get the folder where the forms have been saved.

Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Select folder that contains the
returned
Forms", &H400)
If Not Fldr Is Nothing Then
FldrPath = Fldr.Items.Item.Path & "\"
End If
Set Fldr = Nothing
RecordDoc = Dir$(FldrPath & "*.doc")

vConnection.ConnectionString = _
"data source=c:\path\databasename.mdb;" & _
"Provider=Microsoft.Jet.OLEDB.4.0;"

vConnection.Open

vRecordSet.Open "tblSources", vConnection, adOpenKeyset,
adLockOptimistic

i = 0
While RecordDoc <> ""
vRecordSet.AddNew
Set Source = Documents.Open(FldrPath & RecordDoc)
With Source
For j = 1 To vRecordSet.Fields.Count
If .Bookmarks.Exists(vRecordSet.Fields(j - 1).Name)
Then
If .FormFields(vRecordSet.Fields(j -
1).Name).Result
<>
""
Then
vRecordSet(vRecordSet.Fields(j - 1).Name) = _
.FormFields(vRecordSet.Fields(j -
1).Name).Result
End If
End If
Next j
End With
vRecordSet.Update
i = i + 1
FileToKill = Source.FullName
Source.SaveAs FldrPath & "Processed\" & Source.Name
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top