VBA/Excel/Access/Word/Access/Database Password
Версия от 19:33, 26 мая 2010; (обсуждение)
Содержание
Changing a User Password
<source lang="vb">
Sub Change_UserPassword()
Dim cat As ADOX.Catalog Dim strDB As String Dim strSysDb As String On Error GoTo ErrorHandle strDB = CurrentProject.Path & "\mydb.mdb" strSysDb = "C:\System.mdw" Set cat = New ADOX.Catalog With cat .ActiveConnection = "Provider="Microsoft.Jet.OLEDB.4.0";" & _ "Data Source="" & strDB & "";" & _ "Jet OLEDB:System Database="" & strSysDb & "";" & _ "User Id=Admin;Password=;" .Users("Admin").ChangePassword " ", "secret" End With
ExitHere:
Set cat = Nothing Exit Sub
ErrorHandle:
MsgBox Err.Description GoTo ExitHere
End Sub
</source>
Deleting a Database Password with SQL command
<source lang="vb">
Sub DeleteDbPassword()
Dim conn As ADODB.Connection Dim strPath As String Dim strPass As String On Error GoTo ErrorHandler strPath = CurrentProject.Path strPass = "secret" Set conn = New ADODB.Connection With conn .Mode = adModeShareExclusive .Open "Provider = Microsoft.Jet.OleDb.4.0;" & _ "Data Source=" & strPath & "\mydb.mdb;" _ & "Jet OLEDB:Database Password = " & strPass .Execute "ALTER DATABASE PASSWORD null secret" End With
ExitHere:
If Not conn Is Nothing Then If conn.State = adStateOpen Then conn.Close End If Set conn = Nothing Exit Sub
ErrorHandler:
Debug.Print Err.Number & ":" & Err.Description Resume ExitHere
End Sub
</source>
Embedding a Database Password in Code
<source lang="vb">
Sub LinkToSecured()
Dim cat As ADOX.Catalog Dim tbl As ADOX.Table Set cat = New ADOX.Catalog cat.ActiveConnection = CurrentProject.Connection Set tbl = New ADOX.Table tbl.Name = "tblLinkedTable" Set tbl.ParentCatalog = cat tbl.Properties("Jet OLEDB:Create Link") = True tbl.Properties("Jet OLEDB:Link Provider String") = "ODBC" & _ ";DATABASE=Pubs" & _ ";UID=SA" & _ ";PWD=" & _ ";DSN=PublisherData" tbl.Properties("Jet OLEDB:Remote Table Name") = "Employees" cat.Tables.Append tbl
End Sub
</source>
Requiring Password Validation
<source lang="vb">
Sub ReallySecure()
Dim cat As ADOX.Catalog Dim tbl As ADOX.Table Dim strPassword As String Set cat = New ADOX.Catalog cat.ActiveConnection = CurrentProject.Connection Set tbl = New ADOX.Table tbl.Name = "tblLinkedTable" Set tbl.ParentCatalog = cat strPassword = "pass" tbl.Properties("Jet OLEDB:Create Link") = True tbl.Properties("Jet OLEDB:Link Provider String") = "ODBC" & _ ";DATABASE=Pubs" & _ ";UID=SA" & _ ";PWD=" & strPassword & _ ";DSN=YourData" tbl.Properties("Jet OLEDB:Remote Table Name") = "Employees" cat.Tables.Append tbl
End Sub
</source>
Setting a Database Password
<source lang="vb">
Sub Change_DBPassword()
Dim jetEng As JRO.JetEngine Dim strCompactFrom As String Dim strCompactTo As String Dim strPath As String On Error GoTo ErrHandle strPath = CurrentProject.Path & "\" strCompactFrom = "mydb.mdb" strCompactTo = "mydb_.mdb" Set jetEng = New JRO.JetEngine jetEng.rupactDatabase "Data Source=" & strPath & strCompactFrom & ";", _ "Data Source=" & strPath & strCompactTo & ";" & _ "Jet OLEDB:Database Password=welcome"
ExitHere:
Set jetEng = Nothing Exit Sub
ErrHandle:
If Err.Number = -2147217897 Then Kill strPath & strCompactTo Resume Else MsgBox Err.Number & ": " & Err.Description Resume ExitHere End If
End Sub
</source>
Setting a Database Password with SQL command
<source lang="vb">
Sub SetDbPassword()
Dim conn As ADODB.Connection Dim strPath As String On Error GoTo ErrorHandler strPath = CurrentProject.Path Set conn = New ADODB.Connection With conn .Mode = adModeShareExclusive .Open "Provider = Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & strPath & "\mydb.mdb;" .Execute "ALTER DATABASE PASSWORD secret null " End With ExitHere: If Not conn Is Nothing Then If conn.State = adStateOpen Then conn.Close End If Set conn = Nothing Exit Sub ErrorHandler: Debug.Print Err.Number & ":" & Err.Description Resume ExitHere
End Sub
</source>