Nota: fare una copia del file di Access, prima di lanciare questa funzione: elimina e ricrea le tabelle!
Con questa sub riallego le tabelle, senza cambiare il nome del db, mantenendo le primary key delle viste logiche, ed evitando che l'MDB ingrassi.
Private Function getDbName(stringaDiConnessione As String) As String
Dim res As String
Dim x As Long
Dim arr
arr = Split(stringaDiConnessione, ";")
For x = 0 To UBound(arr)
If arr(x) Like "DATABASE=*" Then
res = Replace(arr(x), "DATABASE=", "")
Exit For
End If
Next
getDbName = res
End Function
Public Function RelinkSQLTablesAndViewsAlternativeBoso(ServerName As String, _
Optional UID As String, _
Optional PWD As String) As Boolean
' ServerName As String, _
' DatabaseName As String, _
' Optional UID As String, _
' Optional PWD As String _
')
' Inputs: ServerName: Name of the SQL Server server (string)
' DatabaseName: Name of the database on that server (string)
' UID: User ID if using SQL Server Security (string)
' PWD: Password if using SQL Server Security (string)
'
' This example re-links any tables and views
Dim db As Database
Set db = CurrentDb
Dim tdef As TableDef
Dim indexSQL As String
Dim fld As Field
Dim constr As Variant
Dim HasIndex As Boolean
Dim rst As Recordset
Dim Tablename As String
Dim SourceTableName As String
Dim tablecounter As Integer
Dim i As Integer
Dim oldConnectionString As String
Dim sq As String
'constr = DLookup("ConnectionString", "tblConnections", "Active = True")
' Start by checking whether using Trusted Connection or SQL Server Security
If (Len(UID) > 0 And Len(PWD) = 0) Or (Len(UID) = 0 And Len(PWD) > 0) Then
MsgBox "Must supply both User ID and Password to use SQL Server Security.", _
vbCritical + vbOKOnly, "Security Information Incorrect."
Exit Function
Else
If Len(UID) > 0 And Len(PWD) > 0 Then
' ' Use SQL Server Security
'
' constr = "ODBC;DRIVER={sql server};" & _
' "DATABASE=" & DatabaseName & ";" & _
' "SERVER=" & ServerName & ";" & _
' "UID=" & UID & ";" & _
' "PWD=" & PWD & ";"
' Else
'
' ' Use Trusted Connection
'
' constr = "ODBC;DRIVER={sql server};" & _
' "DATABASE=" & DatabaseName & ";" & _
' "SERVER=" & ServerName & ";" & _
' "Trusted_Connection=YES;"
' End If
' End If
' Use SQL Server Security
constr = "ODBC;DRIVER={sql server};" & _
"SERVER=" & ServerName & ";" & _
"UID=" & UID & ";" & _
"PWD=" & PWD & ";"
Else
' Use Trusted Connection
constr = "ODBC;DRIVER={sql server};" & _
"SERVER=" & ServerName & ";" & _
"Trusted_Connection=YES;"
End If
End If
'-- TESTA LA CONNESSIONE --------------------------------------------------
Dim cnA As New ADODB.Connection
Dim wStringaDiConnessione As String
Dim allOK As Boolean
allOK = False
If UID <> "" Then
wStringaDiConnessione = "Provider=SQLOLEDB.1;Password=" & PWD & ";Persist Security Info=True;User ID=" & UID & ";Data Source=" & ServerName
Else
wStringaDiConnessione = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;User ID=sa;Data Source=" & ServerName
End If
With cnA
.Open wStringaDiConnessione
If .State = adStateOpen Then
allOK = True
.Close
End If
End With
Set cnA = Nothing
If Not allOK Then Exit Function
'--------------------------------------------------------------------------
' find all the tables to be relinked
sq = ""
sq = sq & "SELECT MSysObjects.Connect, MSysObjects.ForeignName, MSysObjects.Type, MSysObjects.Name "
sq = sq & "FROM MSysObjects "
sq = sq & "WHERE (((MSysObjects.Connect) Like '*DSN=*' Or (MSysObjects.Connect) Like '*sql server*')); "
Set rst = db.OpenRecordset(sq, dbOpenDynaset)
If rst.EOF Then
MsgBox "Not fonud!"
Exit Function
End If
Debug.Print
Debug.Print "**** Relinking on server " & ServerName
Debug.Print
rst.MoveLast
' get a count of how many records to process
tablecounter = rst.RecordCount
rst.MoveFirst
For i = 1 To tablecounter
Set tdef = db.TableDefs(rst!Name)
oldConnectionString = tdef.Connect
HasIndex = False
If tdef.Indexes.Count = 1 Then
' only interested in objects with 1 index
indexSQL = "CREATE INDEX " & tdef.Indexes(0).Name & " ON [" & tdef.Name & "](" & tdef.Indexes(0).Fields & ")"
' convert field list from (+fld1;+fld2) to (fld1,fld2)
indexSQL = Replace(indexSQL, "+", "")
indexSQL = Replace(indexSQL, ";", ",")
HasIndex = True
End If
Tablename = tdef.Name
SourceTableName = tdef.SourceTableName
Set tdef = Nothing
db.TableDefs.Delete Tablename
Set tdef = New TableDef
tdef.Name = Tablename
tdef.SourceTableName = SourceTableName
'tdef.Connect = constr
tdef.Connect = constr & "DATABASE=" & getDbName(oldConnectionString)
'Debug.Print tdef.Name, tdef.Connect
Const lung As Long = 30
Debug.Print Left(tdef.Name & Space(lung), lung) & Space(4) & tdef.Connect
db.TableDefs.Append tdef
' if index now removed then re-create it
If HasIndex And tdef.Indexes.Count = 0 Then
CurrentDb.Execute indexSQL
End If
rst.MoveNext
Next
Debug.Print
Debug.Print "**** Re-linked " & tablecounter & " tables."
Debug.Print "**** DONE."
RelinkSQLTablesAndViewsAlternativeBoso = True
End Function
Esempio di utilizzo, con username e password:
RelinkSQLTablesAndViewsAlternativeBoso "ITSRV01\SQL2008", "sa", "xxxx"
Utilizzando la connessione trusted:
RelinkSQLTablesAndViewsAlternativeBoso "ITSRV01\SQL2008"
Mashup delle funzioni trovate qui e qui.
