Ein Hallo an alle die mir geantwortet haben.
Nach den vielen Hinweisen habe ich ein Script aus verschiedenen anderen Scrips zusammengebastelt.
Damit lese ich als erstens die mit ODBC verknüften Tabellen aus und schreibe die in eine Tabelle,
Felder und TabName aus dem Script ersichtlich.
Für alle den Script, falls Bedarf:
Option Compare Database
Option Explicit
Public Const ServerName$ = "XXXXX\SQLEXPRESS"
Public Const DNS = "YYYYYY"
Public Const DNS_1 = " YYYYYY Reorg"
Public Const DbName$ = "ZZZZZZ"
' 1. Schritt
Function ODBCaktualisieren()
Dim DB As Database
Dim rs As Recordset
Dim tmp As Recordset
Dim td As TableDef
Dim AnzT As Integer
Dim I%
Dim strConn As String
Dim strDBPath As String
Dim strTabName As String
Dim strSQL As String
1
DoCmd.Hourglass True
2
strSQL = "Delete From TblODBCDataSources"
3
DoCmd.SetWarnings False
4
DoCmd.RunSQL strSQL, False
5
DoCmd.SetWarnings True
6
Set DB = CurrentDb
7
Set rs = DB.OpenRecordset("TblODBCDataSources", dbOpenDynaset, dbSeeChanges)
8
AnzT = DB.TableDefs.Count
9 For I = 0 To AnzT - 1
10
DoEvents
11
On Error Resume Next
12
strTabName = DB.TableDefs(I).Name
13
strConn = DB.TableDefs(I).Connect
14
If strConn <> "" Then
15
Set tmp = DB.TableDefs(strTabName).OpenRecordset(dbOpenSnapshot)
16
tmp.MoveLast
17
strDBPath = Mid$(LCase$(strConn), InStr(LCase$(strConn), "database=") + 9)
18
If InStr(strDBPath, ";") <> 0 Then
19
strDBPath = Left$(strDBPath, InStr(strDBPath, ";") - 1)
20
End If
21
rs.AddNew
22
rs("LocalTableName") = strTabName
23
rs("Database") = strDBPath
24
rs("UID") = "SA"
25
rs("PWD") = Null
26
rs("Server") = ServerName$
27
If Right(strTabName, 6) = "archiv" Then
28
rs("DSN") = DNS_1
29
Else
30
rs("DSN") = DNS
31
End If
32
If Right(strTabName, 6) = "archiv" Then
33
rs("ODBCTableName") = "dbo." & Mid(strTabName, 1, Len(strTabName) - 7)
34
Else
35
rs("ODBCTableName") = "dbo." & strTabName
36
End If
37
rs.Update
38
tmp.Close
39
End If
40
Next I
41
DoEvents
42
rs.Close
43
DoEvents
44
DoCmd.Hourglass False
45
Call CreateODBCLinkedTables ‘ zu 2. Schritt
End Function
'2. Schritt
Function CreateODBCLinkedTables() As Boolean
46
On Error GoTo CreateODBCLinkedTables_Err
Dim strTblName As String
Dim strConn As String
Dim DB As DAO.Database
Dim rs As DAO.Recordset
Dim tbl As DAO.TableDef
Dim strDSN As String
' ---------------------------------------------
' Register ODBC database(s).
' ---------------------------------------------
47
Set DB = CurrentDb
48
Set rs = DB.OpenRecordset("Select * From tblODBCDataSources Order By DSN")
49
With rs
50
While Not .EOF
51
If strDSN <> rs("DSN") Then
52
DBEngine.RegisterDatabase rs("DSN"), _
"SQL Server", _
True, _
"Description=VSS - " & rs("DataBase") & _
Chr(13) & "Server=" & rs("Server") & _
Chr(13) & "Database=" & rs("DataBase")
53
End If
54
strDSN = rs("DSN")
' ---------------------------------------------
' Link table.
' ---------------------------------------------
55
strTblName = rs("LocalTableName")
56
strConn = "ODBC;"
57
strConn = strConn & "DSN=" & rs("DSN") & ";"
58
strConn = strConn & "APP=Microsoft Access;"
59
strConn = strConn & "DATABASE=" & rs("DataBase") & ";"
60
strConn = strConn & "UID=" & rs("UID") & ";"
61
strConn = strConn & "PWD=" & rs("PWD") & ";"
62
strConn = strConn & "TABLE=" & rs("ODBCTableName")
63 If (DoesTblExist(strTblName)
= False) Then
64
Set tbl = DB.CreateTableDef(strTblName, _
dbAttachSavePWD, rs("ODBCTableName"), _
strConn)
65
DB.TableDefs.Append tbl
66
Else
67
Set tbl = DB.TableDefs(strTblName)
68
tbl.Connect = strConn
69
tbl.RefreshLink
70
End If
71
rs.MoveNext
72
Wend
73 End With
74
CreateODBCLinkedTables = True
75
MsgBox "Die Tabellen sind aktualisiert", vbInformation
CreateODBCLinkedTables_End:
76
Exit Function
CreateODBCLinkedTables_Err:
77
MsgBox Err.Description, vbCritical, "MyApp"
78
Resume CreateODBCLinkedTables_End
End Function
Function DoesTblExist(strTblName As String) As Boolean
79
On Error Resume Next
Dim DB As DAO.Database
Dim tbl As DAO.TableDef
80
Set DB = CurrentDb
81
Set tbl = DB.TableDefs(strTblName)
82
If Err.Number = 3265 Then ' Item not found.
83
DoesTblExist = False
84
Exit Function
85
End If
86
DoesTblExist = True
End Function
Volker
