◆◆◆◆◆◆◆请大家帮忙解决,急需谢谢!!!!◆◆◆◆◆◆◆◆◆◆◆

Question

请给实例！请给实例！请给实例！请给实例！请给实例！请给实例！关于用ADO创建带密码的数据库（还有就是创建时出现工作组信息文件不存在，请帮忙解决，谢谢大家！）

Answer 1

'参阅:
如何在用命令创建的ACEESS数据库中用命令加密码？
http://www.csdn.net/expert/topic/134/134226.shtmDim MDBPassword As String
MDBPassword = "test"
Dim x As New ADOX.Catalog
x.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\new2K.mdb"
Set x.ActiveConnection = Nothing
Dim y As New ADODB.Connection
y.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\new2K.mdb;Mode=Share Deny Read|Share Deny Write;Persist Security Info=False"
y.Execute "ALTER DATABASE PASSWORD " & MDBPassword & " Null"
y.Close
y.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\new2K.mdb;Persist Security Info=False;Jet OLEDB:Database Password=" & MDBPassword
MsgBox y.State

Answer 2

'参阅:
如何在用命令创建的ACEESS数据库中用命令加密码？
http://www.csdn.net/expert/topic/134/134226.shtmOption Explicit
Public Function CreateMdb(MdbFileNameX As String, Optional PasswordX As String, Optional WithoutTestX As Boolean) As String
If VBA.Len(VBA.Trim(VBA.Dir(VBA.Left(MdbFileNameX, VBA.InStrRev(MdbFileNameX, "\")), vbDirectory))) > 0 Then
   If VBA.Len(VBA.Trim(VBA.Dir(MdbFileNameX))) <= 0 Then
      Dim x As New ADOX.Catalog
      x.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & VBA.Trim(MdbFileNameX)
      If VBA.Len(VBA.Trim(PasswordX)) > 0 Then
         Set x.ActiveConnection = Nothing
         Dim y As New ADODB.Connection
         y.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & MdbFileNameX & ";Mode=Share Deny Read|Share Deny Write"
         y.Execute "ALTER DATABASE PASSWORD " & PasswordX & " NULL"
         If Not WithoutTestX Then
            y.Close
            On Error GoTo TestErrorHandle
            y.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & MdbFileNameX & ";Jet OLEDB:Database Password=" & PasswordX
            On Error GoTo 0
         End If
      End If
   Else
      CreateMdb = "目标文件已存在,建库失败!"
   End If
Else
   CreateMdb = "目标目录不存在,建库失败!"
End If
Exit Function
TestErrorHandle:
CreateMdb = Err.Number & ":" & vbCrLf & Err.Description & "测试失败!"
End Function
Private Sub Command1_Click()
Dim temp As String
Dim MdbFileName  As String
MdbFileName = VBA.Trim(VBA.InputBox("MDB File Name & Path:", "Please Input", App.Path & "\xxx.mdb"))
If VBA.Len(MdbFileName) > 0 Then
   Dim MdbPassword  As String
   MdbPassword = VBA.Trim(VBA.InputBox("MDB Password:", "Please Input"))
   temp = CreateMdb(MdbFileName, MdbPassword)
   If VBA.Len(VBA.Trim(temp)) > 0 Then
      MsgBox temp, vbCritical
   Else
      MsgBox "建库成功!", vbInformation
   End If
End If
End Sub