Connect to Machine DNS and Link table with Access 2010 VBA

[MacroAlan]

I have 8 different DNSs that I need to connect thru Access VBA in turn, link three tables (same name in each DB), pull specific pieces of data from each one and go on to the next.

The names of the DNSs all start with the same thing and I've built an array of the suffixes.

I'm having problems writing the connection strings.

Sub GetPerveData()
    Dim RS           As Recordset
    Dim db           As Database
    Dim dbLoc        As Database
    Dim WS           As Workspace
    Dim rsLOC        As String
    Dim strSQL       As String
    
    Set dbLoc = CurrentDb
    strSQL = "SELECT tblLocations.Code FROM tblLocations ORDER BY Code;"
    
    Set RS = dbLoc.OpenRecordset(strSQL, dbOpenDynaset)
    RS.MoveFirst
    Do Until RS.EOF
        rsLOC = RS!Code
        
 '   Set WS = CreateWorkspace("", "Global", "", dbUseODBC)'not working

    Set db = OpenDatabase("", , True, "ODBC;DSN=Global_" & rsLOC & "SERVERNAME=Aardvark;uid=Global;pwd='';")
        DoCmd.TransferDatabase acLink, "Global_" & rsLOC, , "Job_Header"
        RS.MoveNext
    Loop
    MsgBox "Got to here"
 '  db.Execute "{ call sp_InsertText}"
End Sub

I know I have a problem in OpenDatabase. It pops up the dialog to go to DNS. I want to go directly there, link my tables, and keep going.



Alan

 

[PHV]

I'd replace this:
& rsLOC & "SERVERNAME
with this:
& rsLOC & ";SERVERNAME

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[MacroAlan]

Made lots of great changes and it works BUT each time it does the RunSQL, it is asking for the UserID and Password. Can I send these to the SQL event?

Option Compare Database
Option Explicit

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

    
    On Error GoTo ErrHands
    
    'All location identifiers in Array
    LocArray = Array("CEW", "FED", "GEN")
    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_ORDER_HEADER.* INTO V_Order_Header_" & Loc & " FROM V_ORDER_HEADER;"
        DoCmd.RunSQL sqlSTR
        
        sqlSTR = "SELECT V_ORDER_HEADER_DEL.* INTO V_Order_Header_DEL_" & Loc & " FROM V_ORDER_HEADER_DEL;"
        DoCmd.RunSQL sqlSTR
        
        sqlSTR = "SELECT V_ORDER_LINES.* INTO V_Order_Lines_" & Loc & " FROM V_ORDER_LINES;"
        DoCmd.RunSQL sqlSTR
        
        sqlSTR = "SELECT V_ORDER_LINES_DEL.* INTO V_Order_Lines_DEL_" & Loc & " FROM V_ORDER_LINES_DEL;"
        DoCmd.RunSQL sqlSTR
    Next zLoc       'End loop
    DoCmd.SetWarnings True
    MsgBox "Created tables for all Talent locations", vbInformation
    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 tdf     As DAO.TableDef
    
    On Error GoTo ErrHam
    Z = 0
    For Each tdf In CurrentDb.TableDefs
    ' check if table is a linked table
        If Len(tdf.Connect) > 0 Then
            tdf.Connect = "ODBC;DSN=Grobal_" & Loc & ";ServerName=192.30.1.20.1853;APP=Microsoft Access 2010;DATABASE=GLOBAL;Uid=Grobal;DBQ=GROBAL" & Loc
            tdf.RefreshLink
            Z = Z + 1
        End If
    Next
    Debug.Print Z
    Exit Sub
ErrHam:
    MsgBox "Report screwup " & Err.Number & vbCrLf & Err.Description, vbExclamation
End Sub

The “FixLink” mod works great; problem now in SQL.


Alan

 

[MacroAlan]

I solved my own problem. Have to SAVE the password when the tables are linked initially.


Alan