Access VBA

Relink ODBC Tables

First it is on a remote system that he cannot access. Second, it is in a half dozen databases that are have tables that are the same names but put together differently.

Sub MakeNewTables()
    Dim sqlSTR      As String
    Dim Loc         As String
    Dim LocArray    As Variant
    Dim zLoc        As Long

    On Error GoTo ErrHands
 '   Loc = InputBox("What is the location identifier you are working in?", "Location", "BHM")
	'All location identifiers in Array   
    LocArray = Array("ARB", "TEX", "ARK", "BHM", "CAS")
    For zLoc = LBound(LocArray) To UBound(LocArray) 'If I add locations I'm ready   
        Loc = LocArray(zLoc)	'Get the text value   
        FixLink (Loc)		'Relink the current location   

    DoCmd.SetWarnings False
    sqlSTR = "SELECT V_OD_HEADER.* INTO V_OD_Header_" & Loc & " FROM V_OD_HEADER;"
    DoCmd.RunSQL sqlSTR
    	'Need to make the SQL more generic   
    sqlSTR = "SELECT V_OD_HEADER_DEL.* INTO V_OD_Header_DEL_" & Loc & " FROM V_OD_HEADER_DEL;"
    DoCmd.RunSQL sqlSTR
    
    sqlSTR = "SELECT V_OD_LINES.* INTO V_OD_Lines_" & Loc & " FROM V_OD_LINES;"
    DoCmd.RunSQL sqlSTR
    
    sqlSTR = "SELECT V_OD_LINES_DEL.* INTO V_OD_Lines_DEL_" & Loc & " FROM V_OD_LINES_DEL;"
    DoCmd.RunSQL sqlSTR
        
    Next zLoc
    DoCmd.SetWarnings True	'Give back control   
    MsgBox "Created tables for " & now(), vbInformation 'Tell them its done   
    Exit Sub
ErrHands:
    MsgBox "Please report " & Err.Number & vbCrLf & Err.Description, vbCritical
End Sub


Sub FixLink(Loc As String)
    Dim Z       As Long
    Dim cTl     As Control
    Dim Tdef    As DAO.TableDef
   ' Dim Loc     As String
    
    On Error GoTo ErrHam
    Z = 0
    For Each Tdef In CurrentDb.TableDefs
    '' check if table is a linked table 
  
        If Len(Tdef.Connect) > 0 Then
            Tdef.Connect = "ODBC;DSN=Globbal_" & Loc _
                & ";APP=Microsoft Access 2010;DATABASE=GLObBAL;Uid=Grobal;DBQ=GLObBAL" & Loc
            Tdef.RefreshLink
            Z = Z + 1
        End If
    Next

    Exit Sub
ErrHam:
    MsgBox "Report screwup " & Err.Number & vbCrLf & Err.Description, vbExclamation
End Sub