Tables

1.33 Connettersi con ADO ad un database protetto da MDW
  Alessandro Baraldi

Nella sub che segue è mostrato come sia possibile connetersi con ADO ad un database protetto dalla sicurezza a livello utente. Può essere usato solamente con versioni di Access successie ad Access 97.
Public Sub OpenAdoMdw( )

   On Error GoTo ErrHandler

   Dim Cn As New ADODB.Connection
   Dim rsw As New ADODB.Recordset
   Dim sDbName As String
   Dim sWkGrpFile As String
   Dim sSQLStmt As String
   Dim sRecords As String
   Dim idx As Long
  
   '---------------------------------------
   '  Init.
   '---------------------------------------

   sDbName = "C:\Data\MyData.MDB"
   sWkGrpFile = "C:\Data\Secure.MDW"
   sSQLStmt = "SELECT * " & _
                     "FROM tblEmps " & _
                     "ORDER BY EmpID;"
   sRecords = vbNullString

   Cn.Provider = "Microsoft.Jet.OLEDB.4.0;"
   Cn.Properties("Jet OLEDB:System database") = sWkGrpFile
   Cn.Properties("User Id") = "TheBoss"
   Cn.Properties("Password") = "EZ2Remember"
   Cn.Open "Data Source=" & sDbName & ";"
 
   rsw.Open sSQLStmt, Cn, adOpenForwardOnly, adLockReadOnly

   '----------------------------------------------------------
   '  Save values from every field of every record.
   '----------------------------------------------------------

   Do While Not rsw.EOF
       For idx = 0 To (rsw.Fields.Count - 1)
           sRecords = sRecords & rsw.Fields(idx).Value & "| "
       Next idx
       sRecords = sRecords & vbCrLf
       rsw.MoveNext
   Loop

   '----------------------------------------------------------
   '  Display all values from RecordSet on Form.
   '----------------------------------------------------------

   Me!txtEmpRecords.Value = sRecords

CleanUp:

   If rsw.state = adStateOpen Then rsw.Close:  Set rsw = Nothing
   If Cn.state = adStateOpen Then Cn.Close:  Set Cn = Nothing

   Exit Sub

ErrHandler:

   MsgBox "Error in OpenAdoMdw( ) in" & vbCrLf & _
           Me.Name & " form." & vbCrLf & vbCrLf & "Error #" & _
           Err.Number & vbCrLf & Err.Description
   Err.Clear
   GoTo CleanUp

End Sub


Se pensate di avere del materiale freeware interessante e volete pubblicarlo, allora leggete qui.