[已解决]求助各位老师：如何提交浅绿色区域的数据到 Access数据库

qinhuan66

求助各位老师：如何生成浅绿色区域的数据生成到2003Microsoft Access数据库，以委托日期、今收到的姓名和人民币合计金额为准3者相同（如图一）不能重复提交到数据库。
如没数据库自动新建数据库。谢谢。
社会保险基金专用收款收据.rar (10.35 KB, 下载次数: 6)

2013-4-2 10:25 上传

点击文件名下载附件

图一：

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-4-2 15:30

1. Sub 按钮2_Click()
   
2. 
   
3. 
   
4.     Dim AccessFile As String, Database As String, SQL As String
   
5.     Dim StrConn$, strSql$
   
6.     Dim lLastrow&
   
7.     Dim arr, i&, j As Byte
   
8. 
   
9.     Dim AdoxCat As Object
   
10.     Dim AdoCmd As Object
    
11.     Dim AdoConn As Object
    
12.     Dim AdoRst As Object
    
13. 
    
14. 
    
15.     On Error GoTo Errcheck
    
16.     AccessFile = ThisWorkbook.Path & "\收款收剧.mdb"
    
17.     Database = "收款信息"
    
18.     If Dir(AccessFile) = "" Then
    
19. 
    
20.         '检测文件是否存在，不存在则创建数据库
    
21.         Set AdoxCat = CreateObject("adox.catalog")
    
22.         AdoxCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & AccessFile
    
23.         Set AdoConn = AdoxCat.ActiveConnection
    
24.         Set AdoCmd = CreateObject("ADODB.Command")
    
25.         Set AdoCmd.ActiveConnection = AdoConn
    
26.         AdoCmd.CommandText = "CREATE TABLE " & Database & _
    
27.                              " (委托日期 datetime ,缴款人 text(50),项目 text(50),金额 REAL," & _
    
28.                              "成年人正常缴费 real,成年人正常缴费人数 INTEGER," & _
    
29.                              "未成年人正常缴费 real,未成年人正常缴费人数 INTEGER," & _
    
30.                              "备注 text(100),收款方式 text(10));"
    
31.         AdoCmd.Execute , , 1    'adCmdText
    
32.         Set AdoCmd = Nothing
    
33.         Set AdoxCat = Nothing
    
34.         Set AdoConn = Nothing
    
35. 
    
36.     End If
    
37.     If Len([h5]) = 0 Or Len([j9]) = 0 Or Len([j10]) = 0 Then
    
38.         MsgBox "E6,J9,J10数据不完整，请先填好数据再行操作"
    
39.         Exit Sub
    
40.     End If
    
41. 
    
42.     StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
    
43.               "Data Source=" & AccessFile & ";"""
    
44. 
    
45.     Set AdoConn = CreateObject("ADODB.Connection")
    
46. 
    
47.     With AdoConn
    
48.         .CursorLocation = 3
    
49.         .Mode = 3
    
50.         .CommandTimeout = 5
    
51.         .connectionTimeout = 5
    
52.         .Open StrConn
    
53.         If .State <> 1 Then MsgBox "数据库连接失败", vbCritical + vbOKOnly: Exit Sub
    
54.     End With
    
55. 
    
56. 
    
57.     strSql = "select * from " & Database & " where 委托日期=#" & [h5] & "# " & " and 缴款人 like '" & [e6] & "' and 金额=" & [j7]
    
58. 
    
59.     Set AdoRst = AdoConn.Execute(strSql)
    
60.    
    
61.     If AdoRst.RecordCount = 0 Then
    
62.         strSql = " insert into " & Database & " values(#" & _
    
63.                  [h5] & "#,'" & [e6] & "','" & [i6] & "'," & _
    
64.                  [j7] & "," & [j9] & "," & [k9] & "," & _
    
65.                  [j10] & "," & [k10] & ",'" & [d14] & "','" & [k14] & "')"
    
66.         AdoConn.Execute strSql
    
67.         MsgBox "添加成功"
    
68.         [e6] = "": [j9] = "": [j10] = ""
    
69.     Else
    
70.         MsgBox "记录已经存在，不能重复添加"
    
71.     End If
    
72. 
    
73.     AdoConn.Close
    
74.     Set AdoConn = Nothing
    
75.     Exit Sub
    
76. 
    
77. Errcheck:
    
78. 
    
79.     MsgBox Err.Number & vbNewLine & _
    
80.            Err.Description
    
81. End Sub

复制代码

最好在几个 关键的单元格添加数据有效性。
刚刚没想过空值的问题。



  

跳转到最佳答案楼层

hwc2ycy

1. Sub 按钮2_Click()
   
2. 
   
3. 
   
4.     Dim AccessFile As String, Database As String, SQL As String
   
5.     Dim StrConn$, strSql$
   
6.     Dim lLastrow&
   
7.     Dim arr, i&, j As Byte
   
8. 
   
9.     Dim AdoxCat As Object
   
10.     Dim AdoCmd As Object
    
11.     Dim AdoConn As Object
    
12.     Dim AdoRst As Object
    
13. 
    
14. 
    
15.     On Error GoTo Errcheck
    
16.     AccessFile = ThisWorkbook.Path & "\收款收剧.mdb"
    
17.     Database = "收款信息"
    
18.     If Dir(AccessFile) = "" Then
    
19.         
    
20.         '检测文件是否存在，不存在则创建数据库
    
21.         Set AdoxCat = CreateObject("adox.catalog")
    
22.         AdoxCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & AccessFile
    
23.         Set AdoConn = AdoxCat.ActiveConnection
    
24.         Set AdoCmd = CreateObject("ADODB.Command")
    
25.         Set AdoCmd.ActiveConnection = AdoConn
    
26.         AdoCmd.CommandText = "CREATE TABLE " & Database & _
    
27.                              " (委托日期 datetime ,缴款人 text(50),项目 text(50),金额 REAL," & _
    
28.                              "成年人正常缴费 real,成年人正常缴费人数 INTEGER," & _
    
29.                              "未成年人正常缴费 real,未成年人正常缴费人数 INTEGER," & _
    
30.                              "备注 text(100),收款方式 text(10));"
    
31.         AdoCmd.Execute , , 1    'adCmdText
    
32.         Set AdoCmd = Nothing
    
33.         Set AdoxCat = Nothing
    
34.         Set AdoConn = Nothing
    
35. 
    
36.     End If
    
37. 
    
38.     StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
    
39.               "Data Source=" & AccessFile & ";"""
    
40. 
    
41.     Set AdoConn = CreateObject("ADODB.Connection")
    
42. 
    
43.     AdoConn.CursorLocation = 3
    
44.     AdoConn.Mode = 3
    
45.     AdoConn.CommandTimeout = 5
    
46.     AdoConn.connectionTimeout = 5
    
47.     AdoConn.Open StrConn
    
48. 
    
49.     If AdoConn.State <> 1 Then MsgBox "数据库连接失败", vbCritical + vbOKOnly: Exit Sub
    
50. 
    
51.     strSql = "select * from " & Database & " where 委托日期=#" & [h5] & "# " & " and 缴款人 like '" & [e6] & "' and 金额=" & [j7]
    
52.    
    
53.     Set AdoRst = AdoConn.Execute(strSql)
    
54.     If AdoRst.RecordCount = 0 Then
    
55.         strSql = " insert into " & Database & " values(#" & _
    
56.                  [h5] & "#,'" & [e6] & "','" & [i6] & "'," & _
    
57.                  [j7] & "," & [j9] & "," & [k9] & "," & _
    
58.                  [j10] & "," & [k10] & ",'" & [d14] & "','" & [k14] & "')"
    
59.         AdoConn.Execute strSql
    
60.         MsgBox "添加成功"
    
61. 
    
62.     Else
    
63.         MsgBox "记录已经存在，不能重复添加"
    
64.     End If
    
65.    
    
66.     AdoConn.Close
    
67.     Set AdoConn = Nothing
    
68.     Exit Sub
    
69. Errcheck:
    
70. 
    
71.     MsgBox Err.Number & vbNewLine & _
    
72.            Err.Description
    
73. End Sub

复制代码

qinhuan66

hwc2ycy 发表于 2013-4-2 15:06

老师真的很感谢您。能否做到提交后清空黄色这三个单元格的数据，如果三个单元格没值时不能提交到数据库（还有提示）。谢谢

hwc2ycy

1. Sub 按钮2_Click()
   
2. 
   
3. 
   
4.     Dim AccessFile As String, Database As String, SQL As String
   
5.     Dim StrConn$, strSql$
   
6.     Dim lLastrow&
   
7.     Dim arr, i&, j As Byte
   
8. 
   
9.     Dim AdoxCat As Object
   
10.     Dim AdoCmd As Object
    
11.     Dim AdoConn As Object
    
12.     Dim AdoRst As Object
    
13. 
    
14. 
    
15.     On Error GoTo Errcheck
    
16.     AccessFile = ThisWorkbook.Path & "\收款收剧.mdb"
    
17.     Database = "收款信息"
    
18.     If Dir(AccessFile) = "" Then
    
19. 
    
20.         '检测文件是否存在，不存在则创建数据库
    
21.         Set AdoxCat = CreateObject("adox.catalog")
    
22.         AdoxCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & AccessFile
    
23.         Set AdoConn = AdoxCat.ActiveConnection
    
24.         Set AdoCmd = CreateObject("ADODB.Command")
    
25.         Set AdoCmd.ActiveConnection = AdoConn
    
26.         AdoCmd.CommandText = "CREATE TABLE " & Database & _
    
27.                              " (委托日期 datetime ,缴款人 text(50),项目 text(50),金额 REAL," & _
    
28.                              "成年人正常缴费 real,成年人正常缴费人数 INTEGER," & _
    
29.                              "未成年人正常缴费 real,未成年人正常缴费人数 INTEGER," & _
    
30.                              "备注 text(100),收款方式 text(10));"
    
31.         AdoCmd.Execute , , 1    'adCmdText
    
32.         Set AdoCmd = Nothing
    
33.         Set AdoxCat = Nothing
    
34.         Set AdoConn = Nothing
    
35. 
    
36.     End If
    
37.     If Len([h5]) = 0 Or Len([j9]) = 0 Or Len([j10]) = 0 Then
    
38.         MsgBox "E6,J9,J10数据不完整，请先填好数据再行操作"
    
39.         Exit Sub
    
40.     End If
    
41. 
    
42.     StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
    
43.               "Data Source=" & AccessFile & ";"""
    
44. 
    
45.     Set AdoConn = CreateObject("ADODB.Connection")
    
46. 
    
47.     With AdoConn
    
48.         .CursorLocation = 3
    
49.         .Mode = 3
    
50.         .CommandTimeout = 5
    
51.         .connectionTimeout = 5
    
52.         .Open StrConn
    
53.         If .State <> 1 Then MsgBox "数据库连接失败", vbCritical + vbOKOnly: Exit Sub
    
54.     End With
    
55. 
    
56. 
    
57.     strSql = "select * from " & Database & " where 委托日期=#" & [h5] & "# " & " and 缴款人 like '" & [e6] & "' and 金额=" & [j7]
    
58. 
    
59.     Set AdoRst = AdoConn.Execute(strSql)
    
60.    
    
61.     If AdoRst.RecordCount = 0 Then
    
62.         strSql = " insert into " & Database & " values(#" & _
    
63.                  [h5] & "#,'" & [e6] & "','" & [i6] & "'," & _
    
64.                  [j7] & "," & [j9] & "," & [k9] & "," & _
    
65.                  [j10] & "," & [k10] & ",'" & [d14] & "','" & [k14] & "')"
    
66.         AdoConn.Execute strSql
    
67.         MsgBox "添加成功"
    
68.         [e6] = "": [j9] = "": [j10] = ""
    
69.     Else
    
70.         MsgBox "记录已经存在，不能重复添加"
    
71.     End If
    
72. 
    
73.     AdoConn.Close
    
74.     Set AdoConn = Nothing
    
75.     Exit Sub
    
76. 
    
77. Errcheck:
    
78. 
    
79.     MsgBox Err.Number & vbNewLine & _
    
80.            Err.Description
    
81. End Sub

复制代码

最好在几个 关键的单元格添加数据有效性。
刚刚没想过空值的问题。



  

qinhuan66

hwc2ycy 发表于 2013-4-2 15:30
最好在几个 关键的单元格添加数据有效性。
刚刚没想过空值的问题。

老师能否做到在黄色区域输入月份能自动从Microsoft Access数据库提取缴款人、成年人正常缴费、未成年人正常缴费、金额到查询这个工作表.谢谢

附件:
社会保险基金专用收款收据.rar (26.8 KB, 下载次数: 1)

2013-4-2 15:47 上传

点击文件名下载附件

如图:

hwc2ycy

qinhuan66 发表于 2013-4-2 15:47
老师能否做到在黄色区域输入月份能自动从Microsoft Access数据库提取缴款人、成年人正常缴费、未成年人正 ...

再次发贴吧，{:912:}

qinhuan66

hwc2ycy 发表于 2013-4-2 15:49
再次发贴吧，

论坛新贴:

http://www.excelpx.com/thread-298390-1-1.html

麻烦老师了