We help IT Professionals succeed at work.

VBA script to toggle on and off database link

jtequia
jtequia asked
on
Medium Priority
298 Views
Last Modified: 2012-06-27
I have an access db front end app and I want to link to more than 1access db back end. I want my system ( Front end ) to be able to establish the link once a certain module is open ( application form ) and remove link once the form is closed. So i need to be able to write down a script ( VBA routine ) to turn the link on and off.  I know that i can do it with refresh link using a connect property, but i want to know how to establish the link for the first time using VBA from a password-protected database.

Comment
Watch Question

DatabaseMX (Joe Anderson - Microsoft Access MVP)Database Architect / Application Developer
CERTIFIED EXPERT
Top Expert 2007

Commented:
Here is some code I have to do basically that LInk/Unlink:

Public Function MDMM_BuHstEvLogLinkCtl(sOp As String) As Boolean

    Dim sFx As String: sFx = "MDMM_BuHstEvLogLinkCtl"
   
    Select Case sOp
        Case "UnLink"
            On Error Resume Next
            DoCmd.DeleteObject acTable, "YourTableNameHere"
            If Err.Number = 0 Or Err.Number = 7874 Then
                'ignore; Err 0 means no error occurred, Err 7874 means object not found (nothing to delete)
            Else
                GoTo MDMM_BuHstEvLogLinkCtl_Error
            End If
       
        Case "Link"
           'be sure link does not already exist ... call this same function with the UnLink op
            Me.MDMM_BuHstEvLogLinkCtl ("UnLink")
           
           'Now create the link ...
            Dim sPath As String
            On Error GoTo MDMM_BuHstEvLogLinkCtl_Error
            sPath = "YourFolderPathNameHere"
            DoCmd.TransferDatabase acLink, "Microsoft Access", sPath & "MDMMData.mdb", acTable, "YourTableNameHere", "YourTableNameHere"
    End Select

MDMM_BuHstEvLogLinkCtl_Exit:
    Err.Clear
    Exit Function

MDMM_BuHstEvLogLinkCtl_Error:
    MsgBox "An unexpected error has occured!" & vbCrLf & vbCrLf & _
           "Error Information --------------------" & vbCrLf & _
           "Number: " & Err.Number & vbCrLf & _
           "Description: " & Err.Description & vbCrLf & _
           "Procedure: " & sFx & vbCrLf & _
           "Operation: " & sOp & vbCrLf & vbCrLf & _
           "PLEASE ... take a screen shot of this error message showing as much of the screen as possible and email it to the Database Administrator.", 48, "MASS Database Maintenance"
    GoTo MDMM_BuHstEvLogLinkCtl_Exit
   
End Function

Now ... I forget exactly how to include the password ... but form Help ... it shows this:

DoCmd.TransferDatabase acLink, "ODBC Database", _
    "ODBC;DSN=DataSource1;UID=User2;PWD=www;LANGUAGE=us_english;" _
    & "DATABASE=pubs", acTable, "Authors", "dboAuthors"

So, if you can merge that in, I'm thinking it might work ...

mx
Database Architect / Application Developer
CERTIFIED EXPERT
Top Expert 2007
Commented:
Well, believe it or not ... this works:


Public Function MDMM_BuHstEvLogLinkCtl(sOp As String) As Boolean

    Dim sFx As String: sFx = "MDMM_BuHstEvLogLinkCtl"
   
    Select Case sOp
        Case "UnLink"
            On Error Resume Next
            DoCmd.DeleteObject acTable, "Table1"
            If Err.Number = 0 Or Err.Number = 7874 Then
                'ignore; Err 0 means no error occurred, Err 7874 means object not found (nothing to delete)
            Else
                GoTo MDMM_BuHstEvLogLinkCtl_Error
            End If
       
        Case "Link"
           'be sure link does not already exist ... call this same function with the UnLink op
            Call MDMM_BuHstEvLogLinkCtl("UnLink")
           
           'Now create the link ...
            Dim sPath As String
            On Error GoTo MDMM_BuHstEvLogLinkCtl_Error
            sPath = "C:\Documents and Settings\Administrator\Desktop\EE\Test MDBs\EE_WithPassword.mdb"
            SendKeys "ee": SendKeys "{ENTER}" ' ee is the password
            DoCmd.TransferDatabase acLink, "Microsoft Access", sPath, acTable, "Table1", "Table1"
           
    End Select

MDMM_BuHstEvLogLinkCtl_Exit:
    Err.Clear
    Exit Function

MDMM_BuHstEvLogLinkCtl_Error:
    MsgBox "An unexpected error has occured!" & vbCrLf & vbCrLf & _
           "Error Information --------------------" & vbCrLf & _
           "Number: " & Err.Number & vbCrLf & _
           "Description: " & Err.Description & vbCrLf & _
           "Procedure: " & sFx & vbCrLf & _
           "Operation: " & sOp & vbCrLf & vbCrLf & _
           "PLEASE ... take a screen shot of this error message showing as much of the screen as possible and email it to the Database Administrator.", 48, "MASS Database Maintenance"
    GoTo MDMM_BuHstEvLogLinkCtl_Exit
   
End Function

Explore More ContentExplore courses, solutions, and other research materials related to this topic.