Option Compare Database
Option Explicit
Power Tip: Improve the security of database connections
http://gainingaccess.net/SQLAzure/SADownloads.aspx
Public Function GetSafeCnnString() As String
On Error GoTo ErrHandle
_
_
GetSafeCnnString = "ODBC;" _
& "DRIVER=SQL Server Native Client 11.0;" _
& "SERVER=myserver.net;" _
& "DATABASE=MyDatabaseName"
ExitHere:
Exit Function
ErrHandle:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description _
& vbCrLf & "In Procedure GetSafeCnnString"
Resume ExitHere
End Function
: Power Tip: Improve the security of database connections
Public Function InitODBCDB(UserName As String, Password As String) As Boolean
On Error GoTo ErrHandle
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rst As DAO.Recordset
Dim strCnn As String
_
_
strCnn = "ODBC;" _
& "Driver={SQL Server Native Client 11.0};" _
& "SERVER=myserver.net;" _
& "DATABASE=MyDatabaseName"
Set db = CurrentDb
Set qdf = db.CreateQueryDef("")
With qdf
.Connect = strCnn _
& "Uid=" & UserName & ";" _
& "Pwd=" & Password & ";" _
& "Encrypt=Yes;"
.SQL = "SELECT SYSTEM_USER As MyLogin;"
.ReturnsRecords = True
Set rst = .OpenRecordset(dbOpenSnapshot, dbSQLPassThrough)
End With
InitODBCDB = True
ExitHere:
On Error Resume Next
rst.Close
Set rst = Nothing
Set qdf = Nothing
Set db = Nothing
Exit Function
ErrHandle:
InitODBCDB = False
MsgBox "Error " & Err.Number & vbCrLf & Err.Description _
& vbCrLf & "In Procedure InitODBCDB"
Resume ExitHere
End Function
Public Function SecureTablesNViewsRelink() As Boolean
On Error GoTo ErrHandle
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim strConnection As String
Set db = CurrentDb
strConnection = GetSafeCnnString
For Each tdf In db.TableDefs
If Left$(tdf.Connect, 5) = "ODBC;" Then
If Left$(tdf.Name, 1) <> "~" Then
Set tdf = db.TableDefs(tdf.Name)
tdf.Connect = strConnection
If tdf.Attributes < 537001984 Then
tdf.Attributes = dbAttachSavePWD
End If
tdf.RefreshLink
End If
End If
DoEvents
Next tdf
SecureTablesNViewsRelink = True
ExitHere:
On Error Resume Next
Set tdf = Nothing
Set db = Nothing
Exit Function
ErrHandle:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description _
& vbCrLf & "In Procedure SecureTablesNViewsRelink"
Resume ExitHere
End Function
Function SecurePTQueriesRelink() As Boolean
On Error GoTo ErrHandle
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim strConnection As String
Set db = CurrentDb
strConnection = GetSafeCnnString
For Each qdf In db.QueryDefs
If Left$(qdf.Connect, 5) = "ODBC;" Then
If Left$(qdf.Name, 1) <> "~" Then
Set qdf = db.QueryDefs(qdf.Name)
qdf.Connect = strConnection
End If
End If
Next qdf
SecurePTQueriesRelink = True
ExitHere:
On Error Resume Next
Set qdf = Nothing
Set db = Nothing
Exit Function
ErrHandle:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description _
& vbCrLf & "In Procedure SecurePTQueriesRelink"
Resume ExitHere
End Function