访问 - 使用自定义文件名导出子表单筛选结果

时间:2016-02-29 18:25:34

标签: excel excel-vba ms-access access-vba ms-access-2010 vba

我将过滤后的结果从子表单导出到Excel,并根据需要命名Excel文件。这是我的代码:

Sub XcelExport()
Dim Results As Recordset
Dim RecCount As Integer
Dim XcelFileName As String
Dim FilePath As String
Dim wb As Excel.Workbook
Dim XcelFile As Excel.Application

'Set name of file with date
XcelFileName = "MySubform_Results_" & Format(Date, "dd/mm/yyyy") & ".xlsx"

' Set destinaton folder of saved file
FilePath = CurrentProject.Path & "\" & XcelFileName

Set XcelFile = New Excel.Application
Set wb = XcelFile.Workbooks.Add
'Fetch subform record source
Set Results = Forms![MainForm]![MySubform].Form.RecordsetClone

With wb
XcelFile.ScreenUpdating = False
' Add field names to workbook
For RecCount = 0 To Results.Fields.Count - 1
XcelFile.Cells(1, RecCount + 1).Value = Results.Fields(RecCount).Name
Next RecCount

' Copy subform results to Excel file
XcelFile.Range("A2").CopyFromRecordset Results

.SaveAs Filename:=FilePath, FileFormat:=51
XcelFile.ScreenUpdating = True
.Close
End With
Set XcelFile = Nothing
Set Results = Nothing
End Sub

代码有效,有一个漏洞。当我再次运行它时,它会再次创建一个新文件,但.RecordsetClone已消失,因此不会再次导出Subform中的值。除此之外,我发现代码工作非常奇怪,只需看看»使用wb«语句 - 我必须在某些命令上引用XcelFile或者它们不起作用,无论我是否已经将wb设置为XcelFile在上面的代码中(Set wb = XcelFile.Workbooks.Add)。我的代码有什么问题,有没有人有更好的解决方案?

1 个答案:

答案 0 :(得分:0)

So this is final code, I hope It will be useful to someone else too.

Sub XcelExport()
Dim Results As Recordset
Dim RecCount As Integer
Dim XcelFileName As String
Dim FilePath As String
Dim wb As Excel.Workbook
Dim XcelFile As Excel.Application

'Set name of file with date
XcelFileName = "MySubform_Results_" & Format(Date, "dd/mm/yyyy") & ".xlsx"

' Set destinaton folder of saved file
FilePath = CurrentProject.Path & "\" & XcelFileName

Set XcelFile = New Excel.Application
Set wb = XcelFile.Workbooks.Add
'Fetch subform record source
Set Results = Forms![MainForm]![MySubform].Form.RecordsetClone

With wb
XcelFile.ScreenUpdating = False
' Add field names to workbook
For RecCount = 0 To Results.Fields.Count - 1
XcelFile.Cells(1, RecCount + 1).Value = Results.Fields(RecCount).Name
Next RecCount

' Copy subform results to Excel file and set Results to first row
Results.Movefirst
XcelFile.Range("A2").CopyFromRecordset Results

.SaveAs Filename:=FilePath, FileFormat:=51
XcelFile.ScreenUpdating = True
.Close
End With
Set XcelFile = Nothing
Set Results = Nothing
End Sub