我将过滤后的结果从子表单导出到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
)。我的代码有什么问题,有没有人有更好的解决方案?
答案 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