Word 2007 Marco to open Access Database and go to record 1

[magicmandan]

I have the following macro that reads content control values within a word document - saves them to a back end database and then opens the front end to show an access form/subform and highlights the record that has just been changed:

Sub TransferDate()
'On Error GoTo ErrHandler

Dim cc As ContentControl
Dim cnn As ADODB.Connection
Dim rsProcs As ADODB.Recordset

Const strPath As String = "C:\SENDFROMWORD\A1be.accdb"
Const strDB As String = "C:\SENDFROMWORD\A1fe.accdb"


Dim appAccess As Access.Application
Dim strConnection As String
Dim strSQL As String


Dim dtRD As String
Dim strRB As String
Dim strP As String
Dim bytContinue As Byte
Dim lngSuccess As Long

Dim PID As String
Dim RN As String
Dim DIS As String
Dim PN As String
Dim RD As String
Dim RB As String


'get values


For Each cc In ActiveDocument.ContentControls
If cc.Tag = "ccPID" Then
PID = cc.Range.Text
End If

If cc.Tag = "ccRN" Then
RN = cc.Range.Text
End If

If cc.Tag = "ccDis" Then
DIS = cc.Range.Text
End If

If cc.Tag = "ccPN" Then
PN = cc.Range.Text
End If

If cc.Tag = "ccRD" Then
RD = cc.Range.Text
End If

If cc.Tag = "ccRB" Then
RB = cc.Range.Text
End If

Next

'check all fields are complete

If IsNull(PID) Or PID = "" Or PID = " " Then
MsgBox "You must enter a Procedure ID before the A1 database can be updated."
For Each cc In ActiveDocument.ContentControls
If cc.Tag = "ccPID" Then
cc.Range.Select
Exit Sub
End If
Next
End If




If IsNull(RD) Or RD = "" Or RD = " " Then
MsgBox "You must select a Review Date before the A1 database can be updated."
For Each cc In ActiveDocument.ContentControls
If cc.Tag = "ccRD" Then
cc.Range.Select
Exit Sub
End If
Next
End If

If IsNull(RB) Or RB = "" Or RB = " " Then
MsgBox "You must enter the staff name of the person reviewing this procedure before the A1 database can be updated."
For Each cc In ActiveDocument.ContentControls
If cc.Tag = "ccRB" Then
cc.Range.Select
Exit Sub
End If
Next
End If

'-----------------------------------------------------------------------------------
'first check to see if procedure exists

'set connection string
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source = " & strPath


'initiate connection
Set cnn = New ADODB.Connection

'open connection
cnn.Open strConnection

'initiate recordset
Set rsProcs = New ADODB.Recordset

'open tblA1
rsProcs.Open "SELECT tblA1.ProcName FROM tblA1 where tblA1.ProcName = '" & PID & "'", cnn

If rsProcs.EOF Or rsProcs.BOF Then

MsgBox "There is no entry for Procedure " & PID & " on the A1 Document Database. You need to either enter the right procedure number " _
& "or enter the new procedure name and number on the database and then try changing the review date again.", , "Error Message Box: Invalid Procedure Number"

'close the recordset and connection
rsProcs.Close
Set rsProcs = Nothing

cnn.Close
Set cnn = Nothing

' Create new instance of Microsoft Access.
Set appAccess = CreateObject("Access.Application")
appAccess.Visible = True
appAccess.RunCommand acCmdAppMaximize
' Open database in Microsoft Access window.


appAccess.OpenCurrentDatabase strDB

'close the object
Set appAccess = Nothing

Exit Sub

End If

'----------------------------------------------------------------

'check done so now close this connection
rsProcs.Close
Set rsProcs = Nothing

cnn.Close
Set cnn = Nothing

're-initiate connection
Set cnn = New ADODB.Connection

'open connection
cnn.Open strConnection

'Set update sql
strSQL = "UPDATE tblA1 SET tblA1.dateReviewed = #" & Format(RD, "MM-DD-YYYY") & "#, tblA1.ReviewedBy = '" & RB & "', " & _
"tblA1.PTitle = '" & PN & "', tblA1.pDist = '" & DIS & "', tblA1.rNumber = " & RN & " WHERE tblA1.ProcName = '" & PID & "'"
Debug.Print strSQL

'update tblA1
cnn.Execute strSQL, lngSuccess

Debug.Print lngSuccess

'close/set to nothing all


If lngSuccess = 0 Then
MsgBox "Database update failed."
Else
MsgBox "Successfully updated review dates on A1 Database."
End If


cnn.Close
Set cnn = Nothing


' Create new instance of Microsoft Access.
Set appAccess = CreateObject("Access.Application")
appAccess.Visible = True
appAccess.RunCommand acCmdAppMaximize
' Open database in Microsoft Access window.
appAccess.OpenCurrentDatabase strDB

With appAccess


Forms!frmViewA1!frmSub.Form.RecordsetClone.FindFirst "ProcName = '" & PID & "'"
If Not Forms!frmViewA1!frmSub.Form.RecordsetClone.NoMatch Then
Forms!frmViewA1!frmSub.Form.Bookmark = Forms!frmViewA1!frmSub.Form.RecordsetClone.Bookmark
End If
Forms!frmViewA1!frmSub.Form.RecordsetClone.Close
End With

Set appAccess = Nothing

Exit Sub


'ERROR HANDLE
ErrHandler:

MsgBox Err.Number & ": " & Err.Description, _
vbOKOnly, "Error"

On Error GoTo 0

On Error Resume Next

cnn.Close

Set cnn = Nothing

End Sub

-----------------------------------------------------
-----------------------------------------------------

I've associated the macro with a button I've added to the Quick Access Toolbar.

The first time the macro button is clicked the code runs perfectly, the record is updated, Access is opened and the changed record on the subform has been selected.

However if i then close the database, go back to Word - update one of the content control fields and then click the macro button again the back end is updated but the record navigation fails. The form is opened but the first subform record is displayed rather than navigating to the changed record.
I then get the following error from Word:

Run-time error '2450':
Microsoft access cannot find the form 'frmViewA1' referred to in a macro expression or Visual Basic code.

Could anyone shed some light as to why this occurs on the second run. Do i need to close/open objects differently or refresh the word document in some way.

Thanks in advance
Dan.

 

[TonyJollans]

This kind of problem is usually caused by implicit instantiation somewhere or other.

You have:

With appAccess
    Forms!frmViewA1!frm....

You should have:

With appAccess
    [red][b].[/b][/red]Forms!frmViewA1!frm....

Without the dot (on every reference to Forms), and with VBA trying to be helpful, a Forms collection is implitly created and the code 'works'. The object is not properly destroyed, however, and it comes back to haunt you on the second run.


Enjoy,
Tony

------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

I'm working (slowly) on my own website

 

[magicmandan]

That is perfect.

Thank you very much Tony