|
|
楼主 |
发表于 2013-5-25 11:01
|
显示全部楼层
hwc2ycy 发表于 2013-5-17 08:14 
老师如果下面这条代码建立数据库和访问数据库的位置增加一个文件夹（host）如何改呢？
是不是改这句即可？谢谢
AccessFile = ThisWorkbook.Path & "\data.mdb"
原始代码如下：
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([F3]) = 0 Or Len([B5]) = 0 Or Len([B8]) = 0 Or Len([B13]) = 0 Then
MsgBox "定点医疗机构名称(B3)、医保卡号(F3)、姓名(B5)、本次住院医疗费总额(B8)、统筹基金支付(B13)数据输入不完整，请先填好数据再进行提交。"
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] = ""
[F3] = ""
[B5] = ""
[B8] = ""
[B13] = ""
Else
MsgBox "注意：记录已经存在，不能重复添加！"
End If
AdoConn.Close
Set AdoConn = Nothing
Exit Sub
Errcheck:
MsgBox Err.Number & vbNewLine & _
Err.Description
End Sub
|
|
楼主: qinhuan66
IP卡
狗仔卡
发表于 2013-5-20 18:01
显身卡
