10年VBA经验，闲着没事找事干；你出题，我来做，闲着也是闲着

secowu

楼主真是高手啊,遇到一个好东家了.自己也很努力.

glg007

佩服！！！

梦竹2

楼主好厉害哦，向你学习！

OFFICE小菜

太厉害了，呵呵! 什么时候教教我呀？工作的时候才知道什么有用，可惜那时我们已经毕业了，想在工作之余学习，却发现不知道从哪里学起，也没有人可以教你，很难.

zxhzhong

帮我看看这个问题啊 http://club.excelhome.net/thread-642469-1-1.html

谢谢

lgg098

楼主真猛啊，以后我学习ACCESS希望多多指教哦

fanjianglei

接触excelhome不早，但是在这里发现了一片新天地，在平淡的工作中，找到了一个可以使人充实而又增长知识的好地方，喜欢excelhome，发现excelhome才发现电脑上网的必要性，日日新，又日新。

wj286

《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 小时 查看详细资料

youyou1116

向前辈学习....

yaoscom

数据库中有  日期字段，格式 ####-##-#  hh：mm：ss
                        数据  
  怎么取每隔一定时间的一条记录，生成数据集，然后导入excel中