kai wrote:
Hi, All
I used to link a SQL Server 2000 table through ODBC in Access 2003 using
Wizard, now because the security requirement, I want to do the same job
using code. I tried hard, but not successful. Please help.
Thanks
Kai
Code below, watch for wrapping...
--- begin cut here ---
Option Compare Database
Option Explicit
Private Declare Function basODBC_GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal sBuffer As String, lSize As Long) As Long
Sub TestAttachODBC()
AttachODBC "myserver", "mydatabase", "myusername", "mypassword"
End Sub
Function AttachODBC(pstrServer As String, pstrDatabase As String,
pstrUser As String, pstrPassword As String)
' Generic Attach ODBC Tables from SQL Server
' T.Best 14 Nov 2004
' Uses DAO
Dim strSQLTableList As String
Dim dbSQL As DAO.Database
Dim dbLocal As DAO.Database
Dim rst As DAO.Recordset
Dim tdf As DAO.TableDef
Dim strConnect As String
Dim fDropped As Boolean
Dim lngNumTables As Long
Dim lngTable As Long
' SQL Select for getting list of tables
strSQLTableList = "select name from sysobjects where
objectProperty(id,'IsUserTable')=1 " & _
"or objectproperty(id,'IsView')=1"
' Connection string
strConnect = "ODBC;DRIVER={SQL Server}" & _
";SERVER=" & pstrServer & _
";APP=MyApp" & _
";WSID=" & MachineName() & _
";DATABASE=" & pstrDatabase & _
";Address=" & pstrServer & ",1433" & _
";Trusted_Connection=No" & _
";UID=" & pstrUser & _
";PWD=" & pstrPassword & _
";DSN="
Debug.Print strConnect
' open the SQL database
Set dbSQL = DBEngine(0).OpenDatabase("", dbDriverCompleteRequired,
False, strConnect)
Set dbLocal = CurrentDb()
' Drop old ODBC tables
' Note: This may need customising in hetrogeneous environment :-)
Do
' one simple loop will fail to unattach all tables
' so we'll redo the unattach until nothing gets
' unattached.
fDropped = False
For Each tdf In dbLocal.TableDefs
If Len(tdf.Connect) Then
'Debug.Print "Dropping Linked Table " & tdf.Name
dbLocal.TableDefs.Delete tdf.Name
fDropped = True
End If
Next
Set tdf = Nothing
If Not fDropped Then
' if nothing dropped then we've unattached all the tables
Exit Do
End If
Loop
' list tables
Set rst = dbSQL.OpenRecordset(strSQLTableList, dbOpenDynaset,
dbSeeChanges + dbReadOnly + dbSQLPassThrough)
With rst
If .RecordCount Then
.MoveLast
.MoveFirst
lngNumTables = .RecordCount
SysCmd acSysCmdInitMeter, "Attaching Tables", lngNumTables
Do Until .EOF
lngTable = lngTable + 1
SysCmd acSysCmdUpdateMeter, lngTable
Set tdf = dbLocal.CreateTableDef(.Fields("Name"))
tdf.Connect = strConnect
tdf.SourceTableName = .Fields("Name")
dbLocal.TableDefs.Append tdf
Set tdf = Nothing
.MoveNext
Loop
SysCmd acSysCmdRemoveMeter
End If
.Close
End With
Set rst = Nothing
dbSQL.Close
Set dbSQL = Nothing
Set dbLocal = Nothing
End Function
Public Function MachineName() As String
Dim lngNameSize As Long
Dim lngX As Long
Dim strBuffer As String
strBuffer = Space$(255)
lngNameSize = Len(strBuffer)
lngX = basODBC_GetComputerName(strBuffer, lngNameSize)
MachineName = Left$(strBuffer, lngNameSize)
End Function
--- end cut here ---
--
This sig left intentionally blank
