Transfer Data from Word to Excel with VBA

[Rockie]

Hi team, I am chasing some help on this one. I have a word document template with Text Form Fields where data is to be put. I am trying to set it up so that when these fields are filled out in work, you can press a button and the information gets transferred into a related table in excel. Each time word is filled out, the data goes to the new row.

My VBA skills are novice and am chasing some help with where I am at.

The word 2010 document is called Report2.docm
The excel 2010 spreadsheet is called Transfer.xlsx

Here is what I have been able to come across so far.

Private Sub CommandButton1_Click()
'Transfer a single record from the form fields to an Excel workbook.
  Dim doc As Document
  Dim strCompanyName As String
  Dim strPhone As String
  Dim strSQL As String
  Dim cnn As ADODB.Connection
  'Get data.
  Set doc = ThisDocument
  On Error GoTo ErrHandler
        strNearMissID = Chr(39) & doc.FormFields("txtNearMissID").Result & Chr(39)
        strEventDate = Chr(39) & doc.FormFields("txtEventDate").Result & Chr(39)
        strEventTime = Chr(39) & doc.FormFields("txtEventTime").Result & Chr(39)
        strEventLocation = Chr(39) & doc.FormFields("txtEventLocation").Result & Chr(39)
        strWorkstation = Chr(39) & doc.FormFields("txtWorkstation").Result & Chr(39)
        strReportedTo = Chr(39) & doc.FormFields("txtReportedTo").Result & Chr(39)
        strRecordedHistory = Chr(39) & doc.FormFields("txtRecordedHistory").Result & Chr(39)
        strNCOInvolved = Chr(39) & doc.FormFields("txtNCOInvolved").Result & Chr(39)
        strTCLOnDuty = Chr(39) & doc.FormFields("txtTCLOnDuty").Result & Chr(39)
        strDescription = Chr(39) & doc.FormFields("txtDescription").Result & Chr(39)
        strOnShift = Chr(39) & doc.FormFields("txtOnShift").Result & Chr(39)
        strImmediateAction = Chr(39) & doc.FormFields("txtImmediateAction").Result & Chr(39)
        strEvidence = Chr(39) & doc.FormFields("txtEvidence").Result & Chr(39)
                               
  'Define sql string used to insert each record in the destination workbook.
  'Don't omit the $ in the sheet identifier.
  strSQL = "INSERT INTO [Transfer$]" _
    & " (NearMissID, EventDate, EventTime, EventLocation, Workstation, ReportedTo, RecordedHistory, NCOInvolved, TCLOnDuty, Decription, OnShift, ImmediateAction, Evidence)" _
    & " VALUES (" _
    & strNearMissID & ", " _
    & strEventDate _
    & strEventTime _
    & strEventLocation _
    & strWorkstation _
    & strReportedTo _
    & strRecordedHistory _
    & strNCOInvloved _
    & strTCLOnDuty _
    & strDescription _
    & strOnShift _
    & strImmediateAction _
    & strEvidence _
    & ")"
  Debug.Print strSQL
  'Define connection string and open connection to destination workbook file.
  Set cnn = New ADODB.Connection
  With cnn
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .ConnectionString = "Data Source=\\location\Transfer.xlsx" & _
      "Extended Properties=Excel 8.0;"
    .Open
    'Transfer data.
    .Execute strSQL
  End With
  Set doc = Nothing
  Set cnn = Nothing
  Exit Sub
ErrHandler:
  MsgBox Err.Number & ": " & Err.Description, _
    vbOKOnly, "Error"
  On Error GoTo 0
  On Error Resume Next
  cnn.Close
  Set doc = Nothing
  Set cnn = Nothing
  End Sub

The error I am getting is "5941: the request member of the collection does not exist" followed by "Run-Time error '91' - Object variable or with block variable not set"
It is then highlighting the 4th last line of code "cnn.close"

If this is not even close, I'm happy to start again.

Any help would be greatly appreciated

 

[Macropod]

IMHO, you'd do far better to have a macro that runs from the Excel workbook to collect the data periodically. Relying on someone clicking a button is too error-prone. Aside from the fact the user might might not click the button at all, they might realise they need to change the data after clicking the button, in which case, clicking the button again would add a new row. Dealing with both possibilities would require a lot of extra code, including to look up the workbook to find if the record (however you want to identify it) already exists - by the time an update is made, the previous one might not now be on the last row.

 

[Rockie]

Thanks Macropod. I get what you mean, it makes sense. As ultimately, the design of this setup is such that, the word document will be printed or saved and emailed for reporting purposes and the contents will be kept in a central database.

I was ideally hoping to have an access form, where I can enter the information, run a macro to then fill out the word template. The problem I am running into is that in a couple of the data entry areas (set up as a memo box) in access, there is a paragraph of text. When I try and push the data through to word, the information for that field does not transfer, when all the other ones do.

I was trying to see if I could use the word to excel method as a workaround.

Do you know if there is a limit to the amount of text that can be pushed through from access to word?

Cheers

 

[Macropod]

In access, there are two text data types: "text" (up to 255 characters) and "memo" (can be longer than that). Are you sure you were using the 'memo' type?

Regardless, I can easily-enough provide an Excel macro for capturing formfield data from all documents in a folder. The only thing I'd need to know is whether you're capturing data from all formfields or just the ones named in your code.

 

[Rockie]

Yes, I even tried changing from memo to text, which then reduced the text that was already in the table, oops. Anyway, I have confirmed that the fields in question are in memo. Here is the code I am using currently to transfer from access to word. No doubt there may be a more simple way to do it. It is working though (with the exception of the long bodies of text)

Option Compare Database

Function openword(conpath As String)
Dim appword As Word.Application
Dim doc As Word.Document

On Error Resume Next
Error.Clear
Set appword = GetObject(, "word.application")
If Err.Number <> 0 Then
Set appword = New Word.Application
appword.Visible = True
End If
Set doc = appword.Documents.Open(conpath, , True)
appword.Activate

Set doc = Nothing
Set appword = Nothing

End Function

Private Sub BttnOpenDoc_Click()
Dim mydoc As String
mydoc = "\\Location\Report2.docx"
Call openword(mydoc)

End Sub


Private Sub BttnFillWord_Click()
Call FillwordForm

End Sub


Function FillwordForm()
Dim appword As Word.Application
Dim doc As Word.Document
Dim path As String


On Error Resume Next
Error.Clear

Set appword = GetObject(, "word.application")
If Err.Number <> 0 Then
Set appword = New Word.Application
appword.Visible = True
End If
path = "\\Location\Report.docx"
Set doc = appword.Documents.Open(path, , True)
With doc
    .formfields("txtReported").result = Me.txtReported
    .formfields("txtHistory").result = Me.txtHistory
    .formfields("txtID").result = Me.txtID
    .formfields("txtDate").result = Me.txtDate
    .formfields("txtTime").result = Me.txtTime
    .formfields("txtLocation").result = Me.txtLocation
    .formfields("txtWorkstation").result = Me.txtWorkstation
    .formfields("txtNCO").result = Me.txtNCO
    .formfields("txtTCL").result = Me.txtTCL
    .formfields("txtDescription").result = Me.txtDescription
    .formfields("txtOnShift").result = Me.txtOnShift
    .formfields("txtAction").result = Me.txtAction
    .formfields("txtEvidence").result = Me.txtEvidence

appword.Visible = True
appword.Activate
End With

Set doc = Nothing
Set appword = Nothing

End Function

I hope that makes sense. If I can figure out why the large bodies of text (by that I mean one paragraph) to go through id be laughing.

 

[Macropod]

With the code you're using, trying to insert a string of over 255 characters into a protected formfield likely aborts with "Run-time error: 'String too long'".

The following approach overcomes that:

With doc
  .Bookmarks("txtReported").Range.Fields(1).Result.Text = Me.txtReported

You should be able to get your code working by applying the above approach to the output from the memo fields.

 

[Rockie]

Very good. Very good indeed. Now have all the text coming through properly. It is working like a charm.

Appreciate your help Macropod!!