运行 从 Access VBA 覆盖电子表格时出现时间错误 424
Run time error 424 when overwriting spreadsheet from Access VBA
我正在尝试使用 Access VBA 使用 Access 查询的输出覆盖 excel 工作表。我从 this post here 中获取并修改了一些很棒的 Access VBA 代码。任务完成,但最后我收到 运行 次错误:
Run-time Error '424': Object Required
修改后的代码如下。关于为什么会发生这种情况有什么想法吗?
Option Compare Database
Option Explicit
Private Const strFilePath As String = "C:\Users\MyPC\Desktop\Test Tracker\APS_Timeline_Status.xlsm"
Private Const strTQName As String = "q_APS_Timeline_Status_For_Export"
Private Const strSheetName As String = "TimeLine_Status"
Sub Update_timeline_tracker()
SendTQ2XLWbSheet(strTQName, strSheetName, strFilePath).Run
End Sub
Public Function SendTQ2XLWbSheet(strTQName As String, strSheetName As String, strFilePath As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to
' strFilePath is the name and path of the file you want to send this data into.
Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As DAO.Field
Dim strPath As String
On Error GoTo err_handler
DoCmd.SetWarnings False
strPath = strFilePath
Set rst = CurrentDb.OpenRecordset(strTQName)
Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Open(strPath)
Debug.Print strPath
ApXL.Visible = True
Set xlWSh = xlWBk.Worksheets(strSheetName)
ApXL.DisplayAlerts = False
xlWSh.Activate
xlWSh.Range("A1").Select
For Each fld In rst.Fields
ApXL.ActiveCell = fld.Name
ApXL.ActiveCell.Offset(0, 1).Select
Next
rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
' selects the first cell to unselect all cells
xlWSh.Range("A1").Select
rst.Close
xlWBk.SaveAs FileName:="C:\Users\MyPC\Desktop\Test Tracker\APS_Timeline_Status.xlsm"
xlWBk.Close
ApXL.Quit
Set rst = Nothing
Exit_SendTQ2XLWbSheet:
Exit Function
err_handler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
Resume Exit_SendTQ2XLWbSheet
DoCmd.SetWarnings True
End Function
我认为这里的问题是 SendTQ2XLWbSheet
是一个函数,而不是一个对象。因此,您程序的 .run
部分不能 运行 不是对象的东西。这就是为什么您的错误提示需要一个对象。
要"run"按您要求的方式创建子程序或函数,您必须使用术语"call",因此解决方案是:
Sub Update_timeline_tracker()
call SendTQ2XLWbSheet(strTQName, strSheetName, strFilePath)
End Sub
我正在尝试使用 Access VBA 使用 Access 查询的输出覆盖 excel 工作表。我从 this post here 中获取并修改了一些很棒的 Access VBA 代码。任务完成,但最后我收到 运行 次错误:
Run-time Error '424': Object Required
修改后的代码如下。关于为什么会发生这种情况有什么想法吗?
Option Compare Database
Option Explicit
Private Const strFilePath As String = "C:\Users\MyPC\Desktop\Test Tracker\APS_Timeline_Status.xlsm"
Private Const strTQName As String = "q_APS_Timeline_Status_For_Export"
Private Const strSheetName As String = "TimeLine_Status"
Sub Update_timeline_tracker()
SendTQ2XLWbSheet(strTQName, strSheetName, strFilePath).Run
End Sub
Public Function SendTQ2XLWbSheet(strTQName As String, strSheetName As String, strFilePath As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to
' strFilePath is the name and path of the file you want to send this data into.
Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As DAO.Field
Dim strPath As String
On Error GoTo err_handler
DoCmd.SetWarnings False
strPath = strFilePath
Set rst = CurrentDb.OpenRecordset(strTQName)
Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Open(strPath)
Debug.Print strPath
ApXL.Visible = True
Set xlWSh = xlWBk.Worksheets(strSheetName)
ApXL.DisplayAlerts = False
xlWSh.Activate
xlWSh.Range("A1").Select
For Each fld In rst.Fields
ApXL.ActiveCell = fld.Name
ApXL.ActiveCell.Offset(0, 1).Select
Next
rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
' selects the first cell to unselect all cells
xlWSh.Range("A1").Select
rst.Close
xlWBk.SaveAs FileName:="C:\Users\MyPC\Desktop\Test Tracker\APS_Timeline_Status.xlsm"
xlWBk.Close
ApXL.Quit
Set rst = Nothing
Exit_SendTQ2XLWbSheet:
Exit Function
err_handler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
Resume Exit_SendTQ2XLWbSheet
DoCmd.SetWarnings True
End Function
我认为这里的问题是 SendTQ2XLWbSheet
是一个函数,而不是一个对象。因此,您程序的 .run
部分不能 运行 不是对象的东西。这就是为什么您的错误提示需要一个对象。
要"run"按您要求的方式创建子程序或函数,您必须使用术语"call",因此解决方案是:
Sub Update_timeline_tracker()
call SendTQ2XLWbSheet(strTQName, strSheetName, strFilePath)
End Sub