david epsom dot com dot au said:
1) Can't refresh to change from ODBC to MDB
They are already ODBC-linked tables - I just want to point them to a
different server.
2) Stays the same if there is an error
That would appear to be the problem. Unfortunately, no error is returned
(see response below).
3) Looses the connect string if the TDF goes out of scope before the
Refresh.
Well I've tried to keep that code in the loop.
What does your exception handling look like?
I'm checking the return codes for API calls and calling an API error
function for those. Otherwise I am using the standard VBA error
handling/reporting. Here is the entire function:
Public Function RefreshLinksODBC(DSNFile As String) As Boolean
On Error GoTo Error_RefreshLinksODBC
RefreshLinksODBC = False
Dim db As Database
Dim strError As String
Dim lRet As Long, lSize As Long, lErrCode As Long
Dim I As Integer, iSize As Integer
Dim strDesc As String
Dim strWS As String
Dim strPWD As String
Dim strConnect As String
Dim tdf As TableDef
Set db = DBEngine(0)(0)
'Initialize string variables to fixed length for API calls
gstrSQLServer = String(32, vbNullChar)
strDesc = String(32, vbNullChar)
strWS = String(32, vbNullChar)
lRet = SQLReadFileDSN(DSNFile, "ODBC", "SERVER", gstrSQLServer, 32,
lSize)
If lRet Then
If lSize = 0 Then
'Need to prompt for server name
DoCmd.openform "frmSQLServer"
If Len(gstrSQLServer) < 1 Then
msgbox "Must select a Database server!", vbCritical, "Hey
hammerhead!"
GoTo Exit_RefreshLinksODBC
End If
Else
gstrSQLServer = Left(gstrSQLServer, lSize)
End If
Else
GoTo ODBC_Error
End If
'Save new server name in DSN file
lRet = SQLWriteFileDSN(DSNFile, "ODBC", "SERVER", gstrSQLServer)
If lRet = 0 Then GoTo ODBC_Error
lRet = SQLReadFileDSN(DSNFile, "ODBC", "Description", strDesc, 32,
lSize)
If lRet Then
strDesc = Left(strDesc, lSize)
Else
GoTo ODBC_Error
End If
If InStr(1, strDesc, "Backup") > 0 Then
strPWD = "yyyyyyyy"
Else
strPWD = "xxxxxx"
End If
lSize = Len(strWS)
If GetComputerName(strWS, lSize) Then
strWS = Left(strWS, lSize)
Else
err.Raise GetLastError()
End If
strConnect = "ODBC;Description=" & strDesc & ";DRIVER=SQL
Server;SERVER=" & gstrSQLServer & ";UID=sa;PWD=" & strPWD & ";APP=Microsoft
Open Database Connectivity;WSID=" & strWS & ";DATABASE=Prototype"
For Each tdf In db.TableDefs
If tdf.Attributes And dbAttachedODBC Then
tdf.Connect = strConnect
tdf.RefreshLink
db.TableDefs.Refresh
End If
Next
'Set global connect string for PassThrough queries
gstrODBC = strConnect
RefreshLinksODBC = True
GoTo Exit_RefreshLinksODBC
ODBC_Error:
'ODBC error - enumerate
For I = 1 To 8
strError = String(255, vbNullChar)
lRet = SQLInstallerError(I, lErrCode, strError, 255, iSize)
strError = Left(strError, CLng(iSize))
If lErrCode > 0 Then
LogError "RefreshLinksODBC", lErrCode, strError
End If
Next
Exit_RefreshLinksODBC:
Exit Function
Error_RefreshLinksODBC:
Dim errX As error
For Each errX In Errors
LogError "RefreshLinksODBC", errX.Number, errX.Description
Next
Resume Exit_RefreshLinksODBC
End Function
