troubleshooting Question

How does vba programmatically changing a linked table from a network to a local database affect when the append query is set to go to another database?

Avatar of stephenlecomptejr
stephenlecomptejrFlag for United States of America asked on
Microsoft AccessVBA
7 Comments1 Solution12 ViewsLast Modified:
All please note the following query, is showing it will append to another database on the N:\.  Will it do this despite having ran a script that links to another database on the C:\drive?  In fact the following code is listed below.... so I know for sure they are no longer linked.  

But do I also have to go in and change all the links in append queries also?  If so, how do I change the below script to include queries and not just tables?


Public Sub ConnectLinkedTables(Optional bLinkLocally As Boolean)
On Error GoTo Err_Proc

  Dim bError As Boolean
  '
  Dim dDateModifiedFrom As Date
  Dim dDateModifiedTo As Date
  Dim sMessage As String
  Dim bNoErrors As Boolean
  Dim tdf As DAO.TableDef
  Dim sLinkConn As String
  Dim sLinkPath As String
  Dim sPathLink As String
  Dim strNewconnect As String
  Dim pfsBU As Object
  Dim f As Object
  Dim sAdjName As String
  Dim pfs As Object
  Dim sSQL As String
  Dim i As Integer
  Dim sLocalVersionOfFile As String
  Dim sLocalPathOfFileOnly As String
  Dim sNetworkVersionOfFile As String
  Dim bFileExists As Boolean
  Dim lValue As Long
  Dim bAttempt2Fix As Boolean
  Dim sUser As String
  Dim lNotLinked As Long
  Dim sTableNotLinked As String
  
  sUser = GetUserName
  
  '1st process
  'should identify network mappings
  'and put in a table with their perspective
  'c drive counterparts.
  
  'so clear temp table
  'identify if here
  'then run
  'if here
  'fill it up
  'link from net to local
  'then when asked to put back
  'use the table to determine
  'what links where
  
  If TableExists("_tAccessLinks") = False Then
    Call MYMESSAGEBOX("table: _tAccessLinks is missing for this feature")
    GoTo Exit_Proc
  End If
  
  Call CloseAllMainCustomerForms
  
  lValue = Application.GetOption("Error Trapping")
  Call Application.SetOption("Error Trapping", 2)
  
  If bLinkLocally = True Then
    'first build table of links
    
    For Each tdf In CurrentDb.TableDefs
      DoEvents
      If Not Left(tdf.NAME, 4) = "MSys" Then
        If Left(tdf.Connect, 10) = ";DATABASE=" Then
          '
          sLinkConn = tdf.Connect
          '
          sPathLink = Right(sLinkConn, Len(sLinkConn) - 10)
          sLocalVersionOfFile = LOCALVERSIONOFFILE(sPathLink)
          sLocalVersionOfFile = Replace(sLocalVersionOfFile, "C:\_MY_DOCUMENTS_\", GetMyDocuments)
          sLocalPathOfFileOnly = GetFolderPathOnly(sLocalVersionOfFile)
          Set pfsBU = CreateObject("Scripting.FileSystemObject")
          If pfsBU.FileExists(sPathLink) = True Then
            Set pfsBU = CreateObject("Scripting.FileSystemObject")
            Set f = pfsBU.GetFile(sPathLink)
            dDateModifiedFrom = f.DateLastModified
            Set f = Nothing
          End If
          If pfsBU.FileExists(sLocalVersionOfFile) = True Then
            Set f = pfsBU.GetFile(sLocalVersionOfFile)
            dDateModifiedTo = f.DateLastModified
            Set f = Nothing
          End If
          Set pfsBU = Nothing
          'Debug.Print sLinkConn
          
          If Left(sPathLink, 2) <> "C:" And Left(sLinkConn, 3) <> "SQL" Then
            'ensure local file exists
            bFileExists = FileExists(sLocalVersionOfFile)
            'If bFileExists = False Or dDateModifiedFrom <> dDateModifiedTo Then
            If bFileExists = False Then
              Call SendMsg("copying local file to: " & sLocalVersionOfFile)
              Call MakeFolders(sLocalPathOfFileOnly)
              Call CopyFile(sPathLink, sLocalVersionOfFile)
            End If
            '
            If bFileExists = True Then
              'now link to that new file path.
              Call SendMsg("connecting table: " & tdf.NAME & " to: " & sLocalVersionOfFile)
              
              If NetworkLinkConn(tdf.NAME) = "" Then
                sSQL = "INSERT INTO [_tAccessLinks] ([LinkLocal], [LinkNet], [LinkTableName]) VALUES ('" & sLocalVersionOfFile & "', '" & sPathLink & "', '" & tdf.NAME & "')"
                CurrentDb.Execute sSQL
                DoEvents
                
              End If
              
              tdf.Connect = ";DATABASE=" & sLocalVersionOfFile
              tdf.RefreshLink
            Else
              'need a warning that sql link cannot be linked locally.
              
            End If
            
          End If
        End If
      End If
    Next
  End If

  If bLinkLocally = False Then
    For Each tdf In CurrentDb.TableDefs
      DoEvents
      If Not Left(tdf.NAME, 4) = "MSys" Then
        If Left(tdf.Connect, 10) = ";DATABASE=" Then
          '
          sLinkConn = tdf.Connect
          sPathLink = Right(sLinkConn, Len(sLinkConn) - 10)
          sLocalVersionOfFile = sPathLink
          
          If Left(sPathLink, 2) = "C:" And Left(sPathLink, 3) <> "SQL" Then
            'ensure local file exists
            'now link to that new file path.
            sNetworkVersionOfFile = NetworkLinkConn(tdf.NAME)
            Call SendMsg("connecting table: " & tdf.NAME & " to: " & sNetworkVersionOfFile)
            tdf.Connect = ";DATABASE=" & sNetworkVersionOfFile
            tdf.RefreshLink
            
            sSQL = "DELETE FROM [_tAccessLinks] WHERE [LinkTableName] = '" & tdf.NAME & "'"
            CurrentDb.Execute sSQL
            DoEvents
          
          End If
        End If
      End If
    Next
    
  End If
  bNoErrors = True
  
Exit_Proc:
  
  Call ClearMsg
  
  If bNoErrors = True Then
    sMessage = "Successfully "
  Else
    sMessage = "Unsucessfully "
  End If
  
  sMessage = sMessage & " linked: "
  If bLinkLocally = False Then
    sMessage = sMessage & " network files!"
  Else
    sMessage = sMessage & " local files!"
  End If
  
  If lNotLinked > 0 Then
    sMessage = sMessage & vbNewLine & vbNewLine & " with the exception of "
    If lNotLinked > 1 Then
      sMessage = sMessage & lNotLinked & " linked tables."
    Else
      sMessage = sMessage & lNotLinked & " linked table: (" & sTableNotLinked & ")"
      
    End If
  End If
  
  Call MYMESSAGEBOX(sMessage)
  
  On Error Resume Next
  Call RECORD_ACTION("ConnectLinkedTables: -bLinkLocally: " & bLinkLocally & " -bNoErrors: " & bNoErrors)
  Call Application.SetOption("Error Trapping", lValue)
  Exit Sub
  
Err_Proc:

  sTableNotLinked = tdf.NAME
  
  If Err = 3011 And bAttempt2Fix = False Then
    'then table doesn't exist in the local copy...
    'must copy over the latest one..
    lNotLinked = lNotLinked + 1
    
    Call CopyFile(sPathLink, sLocalVersionOfFile)
    Call SendEmail(DEVADMIN_EMAIL, "link locally: (" & bLinkLocally & ") did not completely work for user: " & sUser, "could not link table: (" & sTableNotLinked & ") within database: (" & CurrentDb.NAME & ")")
    bAttempt2Fix = True
    Err.Clear
    
    Resume Next
  Else
    Call SendEmail(DEVADMIN_EMAIL, "link locally: " & bLinkLocally & " not working or user: " & sUser, "could not link table: " & tdf.NAME & " within database: " & sTableNotLinked)
    
  End If
  bError = True
  Call LogError(Err, Err.Description, "_mCommon @ ConnectLinkedTables")
  Resume Exit_Proc

End Sub
ASKER CERTIFIED SOLUTION
Natchiket

Our community of experts have been thoroughly vetted for their expertise and industry experience.

Join our community to see this answer!
Unlock 1 Answer and 7 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 7 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros