请问如何让这段程序在ACCESS的模块中运行?

lsqv

这段程序在EXCEL的VBA环境中运行良好,但不能在ACCESS的模块中运行,请问怎么修改才能让它在ACCESS的模块中运行,或有什么其他的办法能达到同样的效果? Public Sub 采集日报()
Dim Dayi As Integer
Dateinput = CDate(InputBox("请输入日报日期"))
Dayi = Day(Dateinput)
Monthi = Month(Dateinput)
DayStr = Monthi & "月" & Dayi & "日"

If Application.GetOpenFilename = False Then Resume
Weekinput = CurDir
LD = Dir(Weekinput & "\*" & DayStr & "*.xls")
Do While LD <> "" ' 开始循环。
' 跳过当前的目录及上层目录。
If LD <> "." And LD <> ".." Then
' 使用位比较来确定 MyName 代表一目录。
Workbooks.Open LD
ActiveWorkbook.Worksheets(Format(Dayi)).Activate
日报采集
ActiveWorkbook.Close SaveChanges:=False
End If
LD = Dir ' 查找下一个目录。
Loop
End Sub

lsqv

loadhigh: 每次您的指导都能让我的问题迎刃而解,非常感谢! 但是还存在一个问题,即以Weekinput = CurDir ld = Dir(Weekinput & "\*" & DayStr & "*.xls")

取不到想要的文件夹目录,以至不能继续下面的子程序 Option Compare Database
Dim xlapp As New Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset Public Sub 单目录采集日报()
' Dim xlapp As New Excel.Application
' Dim xlbook As Excel.Workbook
' Dim cnn As New ADODB.Connection
' Dim rst As New ADODB.Recordset
Dim Dayi As Integer
Dateinput = CDate(InputBox("请输入日报日期", 系统提示, Date - 1))
Dayi = Day(Dateinput)
Monthi = Month(Dateinput)
DayStr = Monthi & "月" & Dayi & "日"

If xlapp.GetOpenFilename = False Then Resume
Weekinput = CurDir
ld = Dir(Weekinput & "\*" & DayStr & "*.xls")
Do While ld <> "" ' 开始循环。
' 跳过当前的目录及上层目录。
'If ld <> "." And ld <> ".." Then
' 使用位比较来确定 MyName 代表一目录。
Set xlbook = xlapp.Workbooks.Open(ld)
xlbook.Worksheets(Format(Dayi)).Activate
Set xlsheet = xlbook.Worksheets(Format(Dayi))
日报采集
xlbook.Close SaveChanges:=False
' xlbook.Close
xlapp.Quit

rst.Close
Set xlbook = Nothing
Set xlapp = Nothing
Set rst = Nothing
' End If
ld = Dir ' 查找下一个目录。
Loop
End Sub

[此贴子已经被作者于2004-2-20 13:01:38编辑过]

lsqv

loadhigh: 你好! 我的文件不是在同一目录下的,而是根据实际情况在不同的文件中选取的,在excel中,可以用weekinput=curdir随机选择文件,但这个在access中却行不通,不知道有没有其他的方法,另外在我所选择的文件夹中的文件都是*.xls.不需要设定文件的类型. 在下面这个过程中,出现类型不匹配,可能是因为在excel中.Cells(t, 3)是公式,所以不能引入access中,不知怎么解决? t = 4
With xlbook.Worksheets(bm)

Do
rst.AddNew
rst!机型 = .Cells(t, 1).Value
rst!数量 = .Cells(t, 2).Value
rst!单价 = .Cells(t, 3).Value
rst!金额 = .Cells(t, 4).Value
rst!税金 = .Cells(t, 5).Value
rst!不含税金额 = .Cells(t, 6).Value
rst.Update

t = t + 1
Loop Until .Cells(t, 1) = ""
End With 感谢!!!!

[此贴子已经被作者于2004-2-20 15:19:06编辑过]

含笑

请教一个很菜的问题（别扔鸡蛋），就是怎么才能再ACCESS中录制宏（像在EXCEL中那样）？

loadhigh

请将所有的.value去掉。

loadhigh

Weekinput = currentproject.path 也不能运行通过吗？

loadhigh

谢谢你的鼓励。 dir和curdir函数应该是可以在access里运行的。如果你的access文件和那些excel文件都在同一个目录内，应该是可以的。而且你的excel文件名称都是诸如 *1月1日*.xls的吗？ 你也可以将Weekinput = CurDir 改为Weekinput = currentproject.path 试试看。

loadhigh

将这句：Workbooks.Open LD
改为：set xlbook = xlapp.workbooks.open(LD)

loadhigh

在access的模块内首先需要引用microsoft excel application library.(操作在菜单内，工具->引用) 在这段代码内，需要加入如下代码： dim xlapp as new excel.application dm xlbook as excel.workbook 将代码内所有application 替换 xlapp. 将所有的activeworkbook和workboks 替换为xlbook.