[已解决]求助各位老师：为什么写入黄色区域数据到ACCESS出现下面信息。谢谢

qinhuan66

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

2013-5-16 15:34 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-5-17 08:14

(, 下载次数: 7)

上传

点击文件名下载附件

跳转到最佳答案楼层

那么的帅

没有 DATA MDB 文件，无法测试

qinhuan66

那么的帅 发表于 2013-5-16 16:03
没有 DATA MDB 文件，无法测试

我这个附件是没有ACCESS数据库时自动生成的，不知在哪弄错了。谢谢

qinhuan66

代码如下：
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 & "\数据库.mdb"
    Database = "报销统计录入"
    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 & _
                             " (年份 text(4),录入时间 datetime ,序号 text(3),定点医疗机构名称 text(50),医保卡号 text(12),单位名称 text(50)," & _
                             "姓名 text(8),性别 text(2),年龄 text(2),入院日期 datetime ,出院日期 datetime ,住院天数 text(3),出院诊断 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 & ";"""

    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] & "')"
        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

hwc2ycy

错误一：
        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,);"

最后的,号是多余的。

hwc2ycy

错误2：
        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] & "')"

hwc2ycy

插入的语法太长，建议用adorst.addnew
然后通过字段名来写入值，你的SQL字段里很多不该用‘的地方用了’
有些字段名应该在写入值之前就要判断为空的情况。

hwc2ycy

1.         strSql = " insert into " & Database & " values(" & [B2] & ",#" & [D2] & "#,'" & [F2] & "','" & [B3] & "','" & [F3] & "','" & [B4] & "','" & _
   
2.                  [B5] & "','" & [D5] & "','" & [F5] & "',#" & [B6] & "#,#" & [D6] & "#," & [F6].Value & ",'" & [F7] & "'," & _
   
3.                  [B8] & "," & [D8] & "," & [F8] & "," & [B9] & "," & [D9] & "," & [F9] & "," & _
   
4.                  [B10] & "," & [D10] & "," & [F10] & "," & [B11] & "," & [D11] & "," & [F11] & "," & _
   
5.                  [B12] & "," & [D12] & "," & [F12] & "," & [B13] & "," & [D13] & "," & _
   
6.                  [F13] & "," & [B14] & "," & [D14] & "," & [F14] & ")"

复制代码

这里面，当你的任何一个单元格内容未填时，就会引发错误。

hwc2ycy

日期型数据，两边加#
文本型数据，两边加‘
数值型（像INTERGER,REAL,SINGLE），啥都不加。

qinhuan66

hwc2ycy 发表于 2013-5-17 07:16
这里面，当你的任何一个单元格内容未填时，就会引发错误。

老师谢谢您这么早就起来帮我解决问题。谢谢
我测试了一下还是出现以下问题


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

2013-5-17 07:58 上传

点击文件名下载附件

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 = "报销统计录入"
    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 & ";"""

    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].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