1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
|
Option Compare Database
Option Explicit
' From
' http://support.microsoft.com/default.aspx?scid=kb;en-us;208295
'
Public Function Connection(strDSN As String, _
strDataBase As String, _
strODBCTableName As String) As String
Connection = "ODBC;"
Connection = Connection & "DSN=" & strDSN & ";"
Connection = Connection & "APP=2007 Microsoft Office system;"
Connection = Connection & "DATABASE=" & strDataBase & ";"
Connection = Connection & "Trusted_Connection=Yes;"
Connection = Connection & "TABLE=" & strODBCTableName
End Function
Public Sub CreateLinked(strODBCTableName As String, _
strLocalTableName As String, _
strConn As String)
Dim tbl As DAO.TableDef
If (DoesTblExist(strLocalTableName) = False) Then
'Set tbl = CurrentDb.CreateTableDef(strLocalTableName, _
dbAttachSavePWD, _
strODBCTableName, _
strConn)
'CurrentDb.TableDefs.Append tbl
CurrentDb.TableDefs.Append CurrentDb.CreateTableDef(strLocalTableName, _
acTable, _
strODBCTableName, _
strConn)
CurrentDb.TableDefs.Refresh
Else
CurrentDb.TableDefs(strLocalTableName).Connect = strConn
CurrentDb.TableDefs(strLocalTableName).RefreshLink
End If
End Sub
'***************************************************************
'The DoesTblExist function validates the existence of a TableDef
'object in the current database. The result determines if an
'object should be appended or its Connect property refreshed.
'***************************************************************
Function DoesTblExist(strTblName As String) As Boolean
On Error Resume Next
Dim db As DAO.Database, tbl As DAO.TableDef
Set db = CurrentDb
Set tbl = db.TableDefs(strTblName)
If Err.Number = 3265 Then ' Item not found.
DoesTblExist = False
Exit Function
End If
DoesTblExist = True
End Function
Function LinkODBCandYRQTables() As Boolean
On Error GoTo LinkODBCandYEARTables_Err
Dim strConn As String
Dim strDSN As String
Dim strDataBase As String
Dim strServer As String
Dim strLocalTableName As String
Dim strODBCTableName As String
' This is for the Research database
' that contains the actually ATD calculated and submitted data
'Stop ' Adjust the DSN for the specific SQL Server Database connection
strDSN = "Research"
strDataBase = "Research"
strServer = "sqladmin1"
' ---------------------------------------------
' Register ODBC database(s).
' ---------------------------------------------
DBEngine.RegisterDatabase strDSN, _
"SQL Server", _
True, _
"Description=VSS - " & strDataBase & _
Chr(13) & "Server=" & strServer & _
Chr(13) & "Database=" & strDataBase
' ---------------------------------------------
' Link table.
' ---------------------------------------------
'strLocalTableName = "_ODBCDataSources"
'strODBCTableName = "ATD.ODBCDataSources"
'strConn = Connection(strDSN, strDataBase, strODBCTableName)
' CreateLinked strODBCTableName, strLocalTableName, strConn
' The OBDC source table
strConn = Connection("Research", "Research", "ATD.ODBCDataSources")
CreateLinked "ATD.ODBCDataSources", "_ODBCDataSources", strConn
' The table that contains the available General YRQ that can be exported
strConn = Connection("Research", "Research", "ATD.ExportGeneralYRQ")
CreateLinked "ATD.ExportGeneralYRQ", "_GeneralYRQ", strConn
' The table that contains the available General YRQ that can be exported
strConn = Connection("Research", "Research", "ATD.ExportTermYRQ")
CreateLinked "ATD.ExportTermYRQ", "_TermYRQ", strConn
CurrentDb.TableDefs.Refresh
LinkODBCandYRQTables = True
LinkODBCandYEARTables_End:
Exit Function
LinkODBCandYEARTables_Err:
MsgBox Err.Description, vbCritical, "MyApp"
Resume LinkODBCandYEARTables_End
End Function
Function CreateODBCLinkedTables() As Boolean
On Error GoTo CreateODBCLinkedTables_Err
Dim strTblName As String, strConn As String
Dim db As DAO.Database, rs As DAO.Recordset, tbl As DAO.TableDef
Dim strDSN As String
' ---------------------------------------------
' Register ODBC database(s).
' ---------------------------------------------
Set db = CurrentDb
Set rs = db.OpenRecordset("Select * From _ODBCDataSources Order By DSN")
With rs
While Not .EOF
If strDSN <> rs("DSN") Then
DBEngine.RegisterDatabase rs("DSN"), _
"SQL Server", _
True, _
"Description=VSS - " & rs("DataBase") & _
Chr(13) & "Server=" & rs("Server") & _
Chr(13) & "Database=" & rs("DataBase")
End If
strDSN = rs("DSN")
' ---------------------------------------------
' Link table.
' ---------------------------------------------
strTblName = rs("LocalTableName")
strConn = Connection(rs("DSN"), rs("DataBase"), rs("ODBCTableName"))
CreateLinked rs("ODBCTableName"), rs("LocalTableName"), strConn
rs.MoveNext
Wend
End With
CurrentDb.TableDefs.Refresh
CreateODBCLinkedTables = True
'MsgBox "Refreshed ODBC Data Sources", vbInformation
CreateODBCLinkedTables_End:
Exit Function
CreateODBCLinkedTables_Err:
MsgBox Err.Description & vbCrLf & "With strConn = " & strConn, vbCritical, "MyApp"
Resume CreateODBCLinkedTables_End
End Function
|
