[已解决]如何修改本附件新建数据库时自动设定打开数据库密码为123

qinhuan66 · 发表于 2013-5-21 08:48

本帖最后由 qinhuan66 于 2013-5-22 08:29 编辑

求助：如何修改本附件新建数据库时自动设定打开数据库密码为123，现在的代码新建时密码为空。
注：附件（写入数据库代码由hwc2ycy老师编写，在此非常感谢hwc2ycy老师）

报销统计录入.rar (24.53 KB, 下载次数: 9)

2013-5-21 08:44 上传

点击文件名下载附件

Sub 提交到Access数据库()

Dim AccessFile As String, Database As String, SQL As String
Dim StrConn$, strSql$
Dim lLastrow&
Dim arr, i&, j As Byte

Dim AdoxCat As Object
Dim AdoCmd As Object
Dim AdoConn As Object
Dim AdoRst As Object

On Error GoTo Errcheck
AccessFile = ThisWorkbook.Path & "\data.mdb"
Database = "data"
If Dir(AccessFile) = "" Then

      '检测文件是否存在，不存在则创建数据库
      Set AdoxCat = CreateObject("adox.catalog")
      AdoxCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & AccessFile
      Set AdoConn = AdoxCat.ActiveConnection
      Set AdoCmd = CreateObject("ADODB.Command")
      Set AdoCmd.ActiveConnection = AdoConn
      AdoCmd.CommandText = "CREATE TABLE " & Database & _
                           " (年份 INTEGER,录入时间 datetime ,序号 text(3),定点医疗机构名称 text(50),医保卡号 text(12),单位名称 text(50)," & _
                           "姓名 text(8),性别 text(2),年龄 text(2),入院日期 datetime ,出院日期 datetime ,住院天数 INTEGER,出院诊断 text(50)," & _
                           "本次住院医疗费总额 REAL,甲类药费 real,乙类药费 real,进口药费 real,自费药费 real,超出范围 real," & _
                           "进口材料费 real,国产材料费 real,特殊检查费特殊治疗费 real,丙类项目 real,其它费用 real,起付段金额 real," & _
                           "个人政策自付小计 real,自费药品及自费项目 real,实际结算自付 real,统筹基金支付 real,大病求助基金支付 real," & _
                           "个人支付金额 real,本年住院次数 INTEGER,本年范围内费用累计 real,本年大病范围内费用累计 real)"
      AdoCmd.Execute , , 1 'adCmdText
      Set AdoCmd = Nothing
      Set AdoxCat = Nothing
      Set AdoConn = Nothing

End If
If Len([B3]) = 0 Or Len([B5]) = 0 Or Len([B8]) = 0 Then
      MsgBox "定点医疗机构名称(B3)、姓名(B5)、本次住院医疗费总额(B8)数据输入不完整，请先填好数据再进行提交。"
      Exit Sub
End If

' StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source='" & AccessFile & "';"

StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source='" & _
                  AccessFile & "';"

Set AdoConn = CreateObject("ADODB.Connection")

AdoConn.CursorLocation = 3
AdoConn.Mode = 3
AdoConn.CommandTimeout = 5
AdoConn.connectionTimeout = 5
AdoConn.Open StrConn

If AdoConn.State <> 1 Then MsgBox "数据库连接失败", vbCritical + vbOKOnly: Exit Sub

strSql = "select * from " & Database & " where 入院日期=#" & [D6] & "# " & " and 姓名 like '" & [B5] & "' and 本次住院医疗费总额=" & [B8]

Set AdoRst = AdoConn.Execute(strSql)
If AdoRst.RecordCount = 0 Then
      '       strSql = " insert into " & Database & " values(#" & _
               '                [B2] & "#,'" & [D2] & "','" & [F2] & "','" & [B3] & "','" & [F3] & "','" & [B4] & "'," & _
               '                [B5] & "," & [D5] & "," & [F5] & "','" & [B6] & "','" & [D6] & "','" & [F6] & "','" & [F7] & "," & _
               '                [B8] & "," & [D8] & ",'" & [F8] & "','" & [B9] & "','" & [D9] & "','" & [F9] & "," & _
               '                [B10] & "," & [D10] & ",'" & [F10] & "','" & [B11] & "','" & [D11] & "','" & [F11] & "," & _
               '                [B12] & "," & [D12] & ",'" & [F12] & "','" & [B13] & "','" & [D13] & "," & _
               '                [F13] & "," & [B14] & ",'" & [D14] & "','" & [F14] & "')"
      strSql = " insert into " & Database & " values(" & [B2] & ",#" & [D2] & "#,'" & [F2] & "','" & [B3] & "','" & [F3] & "','" & [B4] & "','" & _
               [B5] & "','" & [D5] & "','" & [F5] & "',#" & [B6] & "#,#" & [D6] & "#," & [F6].Value & ",'" & [F7] & "'," & _
               [B8] & "," & [D8] & "," & [F8] & "," & [B9] & "," & [D9] & "," & [F9] & "," & _
               [B10] & "," & [D10] & "," & [F10] & "," & [B11] & "," & [D11] & "," & [F11] & "," & _
               [B12] & "," & [D12] & "," & [F12] & "," & [B13] & "," & [D13] & "," & _
               [F13] & "," & [B14] & "," & [D14] & "," & [F14] & ")"
      AdoConn.Execute strSql
      MsgBox "本次数据已成功添加的数据库"
      [B3] = ""
      [B5] = ""
      [B8] = ""
Else
      MsgBox "注意：记录已经存在，不能重复添加！"
End If

AdoConn.Close
Set AdoConn = Nothing
Exit Sub

Errcheck:

MsgBox Err.Number & vbNewLine & _
         Err.Description
End Sub

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-5-22 07:53

Sub 提交到Access数据库()
Dim AccessFile As String, Database As String, SQL As String
Dim StrConn$, strSql$
Dim lLastrow&
Dim arr, i&, j As Byte
Dim AdoxCat As Object
Dim AdoCmd As Object
Dim AdoConn As Object
Dim AdoRst As Object
On Error GoTo Errcheck
AccessFile = ThisWorkbook.Path & "\data.mdb"
Database = "data"
If Dir(AccessFile) = "" Then
'检测文件是否存在，不存在则创建数据库
Set AdoxCat = CreateObject("adox.catalog")
AdoxCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & AccessFile & ";Jet OLEDB:Database Password=123;"
Set AdoConn = AdoxCat.ActiveConnection
Set AdoCmd = CreateObject("ADODB.Command")
Set AdoCmd.ActiveConnection = AdoConn
AdoCmd.CommandText = "CREATE TABLE " & Database & _
" (年份 INTEGER,录入时间 datetime ,序号 text(3),定点医疗机构名称 text(50),医保卡号 text(12),单位名称 text(50)," & _
"姓名 text(8),性别 text(2),年龄 text(2),入院日期 datetime ,出院日期 datetime ,住院天数 INTEGER,出院诊断 text(50)," & _
"本次住院医疗费总额 REAL,甲类药费 real,乙类药费 real,进口药费 real,自费药费 real,超出范围 real," & _
"进口材料费 real,国产材料费 real,特殊检查费特殊治疗费 real,丙类项目 real,其它费用 real,起付段金额 real," & _
"个人政策自付小计 real,自费药品及自费项目 real,实际结算自付 real,统筹基金支付 real,大病求助基金支付 real," & _
"个人支付金额 real,本年住院次数 INTEGER,本年范围内费用累计 real,本年大病范围内费用累计 real)"
AdoCmd.Execute , , 1 'adCmdText
Set AdoCmd = Nothing
Set AdoxCat = Nothing
Set AdoConn = Nothing
End If
If Len([B3]) = 0 Or Len([B5]) = 0 Or Len([B8]) = 0 Then
MsgBox "定点医疗机构名称(B3)、姓名(B5)、本次住院医疗费总额(B8)数据输入不完整，请先填好数据再进行提交。"
Exit Sub
End If
StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source='" & _
AccessFile & "';jet oledb:Database Password=123"
Set AdoConn = CreateObject("ADODB.Connection")
With AdoConn
.CursorLocation = 3
.Mode = 3
.CommandTimeout = 5
.connectionTimeout = 5
.Open StrConn
End With
strSql = "select * from " & Database & " where 入院日期=#" & [D6] & "# " & " and 姓名 like '" & [B5] & "' and 本次住院医疗费总额=" & [B8]
Set AdoRst = AdoConn.Execute(strSql)
If AdoRst.RecordCount = 0 Then
strSql = " insert into " & Database & " values(" & [B2] & ",#" & [D2] & "#,'" & [F2] & "','" & [B3] & "','" & [F3] & "','" & [B4] & "','" & _
[B5] & "','" & [D5] & "','" & [F5] & "',#" & [B6] & "#,#" & [D6] & "#," & [F6].Value & ",'" & [F7] & "'," & _
[B8] & "," & [D8] & "," & [F8] & "," & [B9] & "," & [D9] & "," & [F9] & "," & _
[B10] & "," & [D10] & "," & [F10] & "," & [B11] & "," & [D11] & "," & [F11] & "," & _
[B12] & "," & [D12] & "," & [F12] & "," & [B13] & "," & [D13] & "," & _
[F13] & "," & [B14] & "," & [D14] & "," & [F14] & ")"
AdoConn.Execute strSql
MsgBox "本次数据已成功添加的数据库"
[B3] = ""
[B5] = ""
[B8] = ""
Else
MsgBox "注意：记录已经存在，不能重复添加！"
End If
AdoConn.Close
Set AdoConn = Nothing
Exit Sub
Errcheck:
MsgBox Err.Number & vbNewLine & _
Err.Description
End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy · 发表于 2013-5-21 09:38

Access 开发人员参考
ALTER USER 或 DATABASE 语句 (Microsoft Access SQL)

更改现有用户或数据库的密码。

语法
ALTER DATABASE PASSWORD newpassword oldpassword

ALTER USER user PASSWORD newpassword oldpassword

ALTER USER 或 DATABASE 语句包含以下部分：

部分说明
user 要添加到工作组信息文件中的用户的名称。
newpassword 与指定的 user 或 database 名称相关联的新密码。
oldpassword 与指定的 user 或 group 名称相关联的现有密码。

hwc2ycy · 发表于 2013-5-21 09:45

估计得用DAO方式了，SQL有可能支持不行。

qinhuan66 · 发表于 2013-5-21 09:48

hwc2ycy 发表于 2013-5-21 09:45
估计得用DAO方式了，SQL有可能支持不行。

是不是要加上这些

On Error Resume Next
If Dir(数据库) = "" Then
      Cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & 数据库 & ";Jet OLEDB:Database Password=123"
Else
      Cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & 数据库 & ";Jet OLEDB:Database Password=123"
      Cat.Tables.Delete 数据表
End If
Set Cat = Nothing
On Error GoTo 0

cnn.Open "provider=microsoft.jet.oledb.4.0;data source=" & 数据库 & ";Jet OLEDB:Database Password=123"
SQL = "select * into " & 数据表 & " from (" & SQL & ")"
cnn.Execute SQL
cnn.Close
Set cnn = Nothing

hwc2ycy · 发表于 2013-5-21 10:03

对呀，你这个方法可以的。
你试试，我有点事先忙会。

hwc2ycy · 发表于 2013-5-22 07:50

就这两相关的两句就成了，你的思路不错，学习了。

AdoxCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & AccessFile & ";Jet OLEDB:Database Password=123;"

复制代码

StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source='" & _
AccessFile & "';jet oledb:Database Password=123"

复制代码

hwc2ycy · 发表于 2013-5-22 07:53

这个最佳答案由 hwc2ycy 给出，感谢 hwc2ycy 的回答。

单击隐藏图章

Sub 提交到Access数据库()
Dim AccessFile As String, Database As String, SQL As String
Dim StrConn$, strSql$
Dim lLastrow&
Dim arr, i&, j As Byte
Dim AdoxCat As Object
Dim AdoCmd As Object
Dim AdoConn As Object
Dim AdoRst As Object
On Error GoTo Errcheck
AccessFile = ThisWorkbook.Path & "\data.mdb"
Database = "data"
If Dir(AccessFile) = "" Then
'检测文件是否存在，不存在则创建数据库
Set AdoxCat = CreateObject("adox.catalog")
AdoxCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & AccessFile & ";Jet OLEDB:Database Password=123;"
Set AdoConn = AdoxCat.ActiveConnection
Set AdoCmd = CreateObject("ADODB.Command")
Set AdoCmd.ActiveConnection = AdoConn
AdoCmd.CommandText = "CREATE TABLE " & Database & _
" (年份 INTEGER,录入时间 datetime ,序号 text(3),定点医疗机构名称 text(50),医保卡号 text(12),单位名称 text(50)," & _
"姓名 text(8),性别 text(2),年龄 text(2),入院日期 datetime ,出院日期 datetime ,住院天数 INTEGER,出院诊断 text(50)," & _
"本次住院医疗费总额 REAL,甲类药费 real,乙类药费 real,进口药费 real,自费药费 real,超出范围 real," & _
"进口材料费 real,国产材料费 real,特殊检查费特殊治疗费 real,丙类项目 real,其它费用 real,起付段金额 real," & _
"个人政策自付小计 real,自费药品及自费项目 real,实际结算自付 real,统筹基金支付 real,大病求助基金支付 real," & _
"个人支付金额 real,本年住院次数 INTEGER,本年范围内费用累计 real,本年大病范围内费用累计 real)"
AdoCmd.Execute , , 1 'adCmdText
Set AdoCmd = Nothing
Set AdoxCat = Nothing
Set AdoConn = Nothing
End If
If Len([B3]) = 0 Or Len([B5]) = 0 Or Len([B8]) = 0 Then
MsgBox "定点医疗机构名称(B3)、姓名(B5)、本次住院医疗费总额(B8)数据输入不完整，请先填好数据再进行提交。"
Exit Sub
End If
StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source='" & _
AccessFile & "';jet oledb:Database Password=123"
Set AdoConn = CreateObject("ADODB.Connection")
With AdoConn
.CursorLocation = 3
.Mode = 3
.CommandTimeout = 5
.connectionTimeout = 5
.Open StrConn
End With
strSql = "select * from " & Database & " where 入院日期=#" & [D6] & "# " & " and 姓名 like '" & [B5] & "' and 本次住院医疗费总额=" & [B8]
Set AdoRst = AdoConn.Execute(strSql)
If AdoRst.RecordCount = 0 Then
strSql = " insert into " & Database & " values(" & [B2] & ",#" & [D2] & "#,'" & [F2] & "','" & [B3] & "','" & [F3] & "','" & [B4] & "','" & _
[B5] & "','" & [D5] & "','" & [F5] & "',#" & [B6] & "#,#" & [D6] & "#," & [F6].Value & ",'" & [F7] & "'," & _
[B8] & "," & [D8] & "," & [F8] & "," & [B9] & "," & [D9] & "," & [F9] & "," & _
[B10] & "," & [D10] & "," & [F10] & "," & [B11] & "," & [D11] & "," & [F11] & "," & _
[B12] & "," & [D12] & "," & [F12] & "," & [B13] & "," & [D13] & "," & _
[F13] & "," & [B14] & "," & [D14] & "," & [F14] & ")"
AdoConn.Execute strSql
MsgBox "本次数据已成功添加的数据库"
[B3] = ""
[B5] = ""
[B8] = ""
Else
MsgBox "注意：记录已经存在，不能重复添加！"
End If
AdoConn.Close
Set AdoConn = Nothing
Exit Sub
Errcheck:
MsgBox Err.Number & vbNewLine & _
Err.Description
End Sub

复制代码

qinhuan66 · 发表于 2013-5-22 18:35

hwc2ycy 发表于 2013-5-22 07:53

您好老师今天我拷贝到2003里操作发现下图错误，删除数据库打开时没问题，但打开第二次就会跳出下图（因为第一次打开时会建新的空白数据）

hwc2ycy · 发表于 2013-5-22 18:57

StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source='" & _
AccessFile & "';jet oledb:Database Password=123"
这个只适用于07-13版本，03肯定不成。

hwc2ycy · 发表于 2013-5-22 18:58

strConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
"Data Source='" & AccessFile & "';jet oledb:Database Password=123"

		自动登录	找回密码
密码			注册

[已解决]如何修改本附件新建数据库时自动设定打开数据库密码为123

评分

评分