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

qinhuan66 · 发表于 2013-5-17 08:30

hwc2ycy 发表于 2013-5-17 08:26
对了，你再帮我做个测试代码中的这段，你改成下面这段试试。

老师经过测试用下面这段代码也可以，谢谢

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

hwc2ycy · 发表于 2013-5-17 08:37

不跳转你F8多试试，另外你的工作表里有事件，你看看是不是跟事件有关。

qinhuan66 · 发表于 2013-5-17 08:43

hwc2ycy 发表于 2013-5-17 08:37
不跳转你F8多试试，另外你的工作表里有事件，你看看是不是跟事件有关。

好的感谢老师的指点。对了我想麻烦您帮我指点一下左上角的序号是否根据数据库里的已存在的序号产生
比如说数据库里已存在6条信息（序号是006），是否能在录入表里自动产生新的序号007，而不用手工输入序号。谢谢！

hwc2ycy · 发表于 2013-5-17 08:48

你可以在打开时，就先查询数据库中有几条记录，然后加1写入单元格。
每次保存记录后，数值自动给加1.

qinhuan66 · 发表于 2013-5-17 09:02

hwc2ycy 发表于 2013-5-17 08:48
你可以在打开时，就先查询数据库中有几条记录，然后加1写入单元格。
每次保存记录后，数值自动给加1.

谢谢老师！我试做了几条都不成功能否写条代码参考？谢谢

hwc2ycy · 发表于 2013-5-17 09:15

本帖最后由 hwc2ycy 于 2013-5-17 09:17 编辑

qinhuan66 发表于 2013-5-17 09:02
谢谢老师！我试做了几条都不成功能否写条代码参考？谢谢

Function getRecordCount() As Long
Dim AccessFile As String, Database As String
Dim StrConn As String, strSql As String
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
getRecordCount = 1
Exit Function
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")
With AdoConn
.CursorLocation = 3
.Mode = 3
.CommandTimeout = 5
.connectionTimeout = 5
.Open StrConn
End With
strSql = "select * from " & Database
Set AdoRst = AdoConn.Execute(strSql)
getRecordCount = AdoRst.RecordCount + 1
AdoConn.Close
Set AdoConn = Nothing
Exit Function
Errcheck:
MsgBox Err.Number & vbNewLine & _
Err.Description
End Function

复制代码

这是返回记录数的，测试交给你了。
worksheets(1).range("f2")=getRecordCount

这个代码放在工作簿OPEN事件里调用

hwc2ycy · 发表于 2013-5-17 09:16

写入的代码里可以直接在提示成功后加上一句

[f2] = [f2] + 1

复制代码

hwc2ycy · 发表于 2013-5-17 09:17

加了后，在写入数据的过程里就不需要再来判断文件是否存在了。

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

hwc2ycy 发表于 2013-5-17 09:15
这是返回记录数的，测试交给你了。
worksheets(1).range("f2")=getRecordCount

好的老师谢谢您了我先测试一下。谢谢

qinhuan66 · 发表于 2013-5-20 10:10

hwc2ycy 发表于 2013-5-17 09:16
写入的代码里可以直接在提示成功后加上一句

老师在线吗？这样的话今天测试发现了一个问题，如果重复输入不再提示，可以重复录入。

AdoConn.Execute strSql
      MsgBox "本次数据已成功添加的数据库"
      [B3] = ""
      [B4] = ""
      [B5] = ""
      [B6] = ""
      [B7] = ""
      [B8] = ""
      [B9] = ""
      [B10] = ""
      [B11] = ""
      [B13] = ""
      [B14] = ""
      [D2] = ""
      [D5] = ""
      [D6] = ""
      [D8] = ""
      [D9] = ""
      [D10] = ""
      [D11] = ""
      [D13] = ""
      [D14] = ""
      [F3] = ""
      [F5] = ""
      [F8] = ""
      [F9] = ""
      [F10] = ""
      [F11] = ""
      [F12] = ""
      [F13] = ""
      [F14] = ""
   [f2] = [f2] + 1
Else
      MsgBox "注意：记录已经存在，不能重复添加！"
End If

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

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

评分