Visual
Basic for Applications (VBA) is the engine that
increases the power of Word and provides the ability to combine the
facilities offered by more than one application (s.a. Access and
Word). VBA allows you to launch and control the behavior of other
applications, so you can call up an Access patient table from your
Word UserForm to add or change a record, send messages using
Outlook, or print out a consultation all from a single block of
code.
Using the CreateObject() Method
Twice to Link to the Backend Tables
|
If the MS Word EMR Project is used multiple times, you may end up with multiple instances of MSACCESS.EXE (in WinXP, do a Ctrl+Alt+Del and look under "Processes"), which is the reason for the Private Sub document_Close() routine which will remove all open instances of MSACCESS.EXE:
The second Access link is created with the Splashscreen UserForm, and this is the final link that points the various UserForms to the actual backend tables:
Methods to Call Up the Actual Back-end Tables
The Splashscreen UserForm offers 4 methods to link to the backend at this stage:
There are 2 variables that are used in linking methods:
Direct Linking to the C:\ Drive
This method relies on this method to link to the actual tables to be used by UserForms:
Dim accessword As Object
Dim Accesswasnotrunning As Boolean ' Flag for final release.
Dim wdWindowStateMaximize As Long
wdWindowStateMaximize = 0
Set accessword = GetObject(, "Access.Application")
If Err.Number <> 0 Then 'test to see if an error occurred
Set accessword = CreateObject("Access.Application")
End If
Set accessword = GetObject("C:\Program Files\MS Word EMR Project 2008\ZMDSBE.mdb",
"Access.Application")
If Err.Number <> 0 Then Accesswasnotrunning = True
Set accessword = CreateObject("C:\Program Files\MS Word EMR Project 2008\ZMDSBE.mdb",
"Access.Application")
If Accesswasnotrunning = True Then
accessword.Application.Quit
End If
accessword.Application.Visible = False 'True
If Err.Number <> 0 Then 'test to see if an error occurred
Set accessword = CreateObject("Access.Application")
End If
With accessword
End With
Set accessword = Nothing
conDBpath2 = "C:\Program Files\MS Word EMR Project 2008\ZMDSBE.mdb"
Direct Linking to the Z:\ Drive
Prior to using this method you need to map the Z:\ drive on every node computer that uses this software. Simply open the Windows Explorer and then select My Network Places ® Entire Network ® right click on computer drive of interest ® select Map Netwoork Drive ® set drive letter to “Z:”:
This method relies on this method to link to the actual tables to be used by UserForms:
Dim accessword As Object
Dim Accesswasnotrunning As Boolean ' Flag for final release.
Dim wdWindowStateMaximize As Long
wdWindowStateMaximize = 0
Set accessword = GetObject(, "Access.Application")
If Err.Number <> 0 Then 'test to see if an error occurred
Set accessword = CreateObject("Access.Application")
End If
Set accessword = GetObject("Z:\Program Files\MS Word EMR Project 2008\ZMDSBE.mdb",
"Access.Application")
If Err.Number <> 0 Then Accesswasnotrunning = True
Set accessword = CreateObject("Z:\Program Files\MS Word EMR Project 2008\ZMDSBE.mdb",
"Access.Application")
If Accesswasnotrunning = True Then
accessword.Application.Quit
End If
accessword.Application.Visible = False 'True
If Err.Number <> 0 Then 'test to see if an error occurred
Set accessword = CreateObject("Access.Application")
End If
With accessword
End With
Set accessword = Nothing
conDBpath2 = "Z:\Program Files\MS Word EMR Project 2008\ZMDSBE.mdb"
Direct Linking to the Current Back-end
This simple, but powerful method is based on the function which sets the GetPath variable with a string denoting the current folder path:
Private Sub CommandButton9_Click()
On Error GoTo eeee
Dim iii As Integer, szPath As String, strdb As String
[PlsWt].Visible = True
zz = ""
ii = 0
Call GetPath
[TextBox2] = GetPath & "\zfilemdscc_be.mdb"
DoCmd.Hourglass True
strdb = Forms!Toolbox![TextBox2]
Call RefreshTableLinks(strdb)
DoCmd.Hourglass False
MsgBox "Connected!", vbExclamation
[PlsWt].Visible = False
Exit Sub
eeee:
MsgBox "An error has occurred!"
Exit Sub
End Sub
Function GetPath()
'Returns the path to currently opened MDB or ADP
GetPath = CurrentProject.Path
End Function
Note that the variable GetPath does not need to be explicitly declared (i.e. "Dim GetPath...").
Direct Linking to the Server Using an API Call
This method begins by setting a global variable in the modGlobals global module:
The following is the code behind the clickbutton, with the API call highlighted in yellow:
Private
Sub CommandButton7_Click()
On Error Resume Next
[PlsWt].Visible = True
XX = "welcome"
Call AutoMacros.BrowseFolder(szDialogTitle = "C:\")
On Error Resume Next
Set db = OpenDatabase(conDBpath)
SQLStmt = "SELECT PathLoc.* FROM PathLoc;"
Set rs = db.OpenRecordset(SQLStmt, dbOpenDynaset)
With rs
.MoveFirst
.Edit
conDBpath2 = [TextBox2].Value
!zfiletables = [TextBox2].Value
.Update
worddoc1 = !worddoc
pdfdoc1 = !pdfdoc
.Close
db.Close
End With
Application.DisplayAlerts = wdAlertsNone
Dim accessword 'As AccessObject
Dim Accesswasnotrunning As Boolean ' Flag for final release.
Dim wdWindowStateMaximize As Long
wdWindowStateMaximize = 0
Set accessword = GetObject(, "Access.Application")
If Err.Number <> 0 Then 'test to see if an error occurred
Set accessword = CreateObject("Access.Application")
End If
XX = [TextBox2].Value
Set accessword = GetObject(XX, "Access.Application")
If Err.Number <> 0 Then Accesswasnotrunning = True
Err.Clear
If Accesswasnotrunning = True Then
accessword.Application.Quit
End If
accessword.Application.Visible = False 'True
If Err.Number <> 0 Then 'test to see if an error occurred
Set accessword = CreateObject("Access.Application")
End If
If Accesswasnotrunning = True Then
accessword.Application.Quit
End If
With accessword
'.WindowState = wdWindowStateMinimize
End With
Set accessword = Nothing
End Sub
The API call above is dependent on these functions located in a global AutoMacros folder: