|
|
请救帮助VBA程序中错误解决办法?
《EXCEL凭证式录入ACCESS保存》VBA程序还存在错误如何解决?
网址如下:
http://club.excelhome.net/viewth ... xtra=&frombbs=1工程－引用 Microsoft ActiveX Data Objects···已引用
工程－引用：Microsoft ADO Ext.2.6 for····已引用
sh.工作表未定义-----已定义
[local]2[/local]EXCEL凭证式录入ACCESS保存中VBA程序有错误,现发贴请教高手帮助解决,谢谢!
Option Explicit
Private Sub 保存Co_Click()
Dim apz(15)
Dim mydata As String, strSQL As String '定义变量为字符串
Dim wb As Workbook '定义变量为工作簿
Dim sh As Worksheet '定义变量为工作表
Dim i As Long, j As Long '定义变量长整形
Dim myCat As New ADOX.Catalog '定义创建数据表目录
Dim myCmd As ADODB.Command '定义数据库异步操作命令
Dim cnn As ADODB.Connection '定义数据库异步操作连接
Dim rs As ADODB.Recordset '定义数据库异步操作记录集
Set wb = ThisWorkbook '设置(给)已定义变量赋值
Set sh = wb.Sheets("记帐凭证") '设置(给)已定义变量赋值
mydata = wb.Path & "\myData.mdb" '数据放在(已定义变量)工作簿路径& "\myData.mdb"
Dim Qj
Dim lkyf As Date
lkyf = sh.Cells(4, 3)
Qj = 8 & Format(lkyf, "00")
strSQL = "max(号码) as HM form[分录2009]" '桌面表格放在"总公司销售记录"
On Error Resume Next
If Dir(mydata) = "" Then '如果目录(已定义变量)工作簿为空那么
myCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & mydata
'变量(定义创建数据表目录)创建提供为微软出应用程序接口数据源为& myData
Set cnn = myCat.ActiveConnection
'设置变量(已定义数据库异步操作连接)为变量(已定义创建数据表目录)激活的连接
Set myCmd = New ADODB.Command
'设置变量(已定义数据库异步操作命令)为新数据库异步操作命令
Set myCmd.ActiveConnection = cnn
'设置变量(已定义数据库异步操作命令)激活的连接为变量(已定义数据库异步操作连接)
myCmd.Execute , , adCmdText
Else '否则
Set cnn = New ADODB.Connection '设置变量(已定义数据库异步操作连接)新的数据库异步操作连接
With cnn '设置由于语句使此更方便地访问其属性
.Provider = "microsoft.jet.oledb.4.0" '提供程序为出应用程序接口
.Open mydata '打开数据(已定义变量)工作簿
End With '结束由于
Set rs = cnn.OpenSchema(adSchemaTables)
'设置变量(已定义数据库异步操作记录集)为变量(已定义数据库异步操作连接)打开架构活动架构桌面数据表格
Do Until rs.EOF '循环-要求在到为止变量(已定义数据库异步操作记录集)范围结束
If LCase(rs!table_name) = LCase(strSQL) Then GoTo hhh
'如果这个范围变量(已定义数据库异步操作记录集)桌面名称
'为这个范围变量(已桌面表格放在"总公司销售记录")那么转到hhh
rs.MoveNext '变量(已定义数据库异步操作记录集)移动到下一步(行)
Loop '循环
Set myCmd = New ADODB.Command '设置变量(已定义数据库异步操作命令)为新数据库异步操作命令
Set myCmd.ActiveConnection = cnn '设置变量(已定义数据库异步操作命令)激活的连接为变量(已定义数据库异步操作连接)
myCmd.Execute , , adCmdText '变量(已定义数据库异步操作命令)执行活动命令文本
hhh:
End If '结束如果
apz(0) = sh.Cells(3, 3)
apz(1) = sh.Cells(3, 6) ''字号
apz(2) = rs!hm
apz(2) = IIf(IsNull(apz(2)), 1, apz(2) + 1) ''''新号码
'If apz(2) <> Val(sh.[H2]) Then MsgBox "凭证号码不连续，请确认月份后，再点[刷新]": GoTo 1 ''''与[增加]时比号(因为可随时选择月份)
'表头数据
apz(9) = sh.[G30] ''''制单
apz(10) = sh.[B3] '''审核
apz(11) = sh.Cells(3, 8) '附件
apz(11) = IIf(Len(apz(13)) = 0, 1, apz(13)) '''附件默认为1张
'逐条分录写入
i = 5
Do While sh.Cells(i, 3) <> "" And i <= 28
apz(15) = Qj & Format(apz(2), "000") & Format(i - 4, "00") '''ID
apz(3) = IIf(sh.Cells(i, 2) <> "", sh.Cells(i, 2), sh.Cells(5, 2)) '摘要
apz(4) = sh.Cells(i, 3) '代码
apz(5) = sh.Cells(i, 4) '科目
apz(6) = sh.Cells(i, 5) '科目
apz(8) = sh.Cells(i, 7) '借方金额
apz(8) = IIf(Len(apz(7)) = 0, 0, apz(7))
apz(8) = sh.Cells(i, 8) '贷方金额
apz(8) = IIf(Len(apz(9)) = 0, 0, apz(9))
apz(7) = sh.Cells(i, 6) '借数量
apz(7) = IIf(Len(apz(7)) = 0, 0, IIf(apz(8) = 0, 0, apz(7))) ''
apz(12) = sh.Cells(i, 6)
apz(12) = IIf(Len(apz(12)) = 0, 0, IIf(apz(8) = 0, 0, apz(12))) ''
strSQL = "INSERT INTO [分录2009](ID,日期,字号,号码,摘要,代码,全称,明细,借数,借金,贷数,贷金,制单,审核,附件) VALUES('" _
& apz(15) & "','" & apz(0) & "','" & apz(1) & "','" & apz(2) & "','" & apz(3) & "','" & apz(4) & "','" & apz(5) & "','" & apz(6) & "','" & apz(7) & "','" & apz(14) & "','" & apz(8) & "','" & apz(9) & "','" & apz(10) & "','" & apz(11) & "','" & apz(12) & "','" & apz(13) & "')"
funCommand strSQL, mydata
i = i + 1
Loop
MsgBox "保存成功"
' rstrst.Close
' Set rstrst = Nothing
rs.Close '变量(已定义数据库异步操作记录集)关闭
cnn.Close '变量 (已定义数据库异步操作连接)
Set wb = Nothing '设置变量没有
Set sh = Nothing
Set rs = Nothing
Set myCmd = Nothing
Set myCat = Nothing
Set cnn = Nothing
1:
Exit Sub
End Sub
UID851601 帖子18 精华0 经验18 威望0 阅读权限20 在线时间24 小时 查看详细资料 |
-
-
E到A.rar
123.48 KB, 下载次数: 28
EXCEL凭证式录入ACCESS中保存
|
楼主: djt
[复制链接]
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2010-8-19 17:58
