Re: Extract form field data to Access

Tech-Archive recommends: Speed Up your PC by fixing your registry

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


"Eric" wrote:

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


"Doug Robbins - Word MVP" wrote:

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

"Eric" <Eric@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
news:C58EE53A-D9BE-4587-9978-3974D7015C74@xxxxxxxxxxxxxxxx
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

--
Your help is greatly appreciated! thanks

Eric the Rookie


"Doug Robbins - Word MVP" wrote:

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

"Eric" <Eric@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
news:34E84983-EF7C-4272-824E-F306E23E23D8@xxxxxxxxxxxxxxxx
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.
--
Eric the Rookie


"Doug Robbins - Word MVP" wrote:

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

"Eric" <Eric@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
news:0B593D01-F3EE-42DF-A80E-8726F71396E7@xxxxxxxxxxxxxxxx
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
.

Relevant Pages

  • Search pattern
    ... Dim strfile As String ... Dim bAddressFound As Boolean ... Dim strCurrentChar As String ...
    (comp.databases.ms-access)
  • Auto Write Name and Merge across
    ... Dim Sheetname01 As String ... Dim WeekName01 As String ...
    (microsoft.public.excel.misc)
  • Re: multiplatform (pocketPC & desktopPC) (Daniel !!)
    ... Friend Versione As String ... Public Sub GetMyConnectionPalmare() ... Dim errorMessages As String ... Private Function GetDS_Desktop(ByVal SQL As String) As DataSet ...
    (microsoft.public.dotnet.framework.compactframework)
  • Re: multiplatform (pocketPC & desktopPC) (Daniel !!)
    ... Friend Versione As String ... Public Sub GetMyConnectionPalmare() ... Dim errorMessages As String ... Private Function GetDS_Desktop(ByVal SQL As String) As DataSet ...
    (microsoft.public.dotnet.framework.compactframework)
  • Help answer these 70-310 questions
    ... One argument is the string ... Dim output As New StringBuilder ... EmployeeLocations. ... You create a strongly named serviced component. ...
    (microsoft.public.cert.exam.mcsd)