将对象粘贴到空单元格/工作表时出现错误 424 未被识别为对象

Posted 2023-02-19

【中文标题】将对象粘贴到空单元格/工作表时出现错误 424 未被识别为对象

【英文标题】：Error 424 when pasting objects to an empty cell/Worksheet isn't recognized as an object

【发布时间】：2018-05-26 02:00:22

【问题描述】：

我对编程很陌生。请你帮我找出问题并可能解决它。下面的宏应该从电子邮件文件夹中提取表格。前两部分工作得很好：我可以打开 Excel 导出文件并选择电子邮件文件夹。但是，导出到文件失败，因为目标电子表格似乎未被识别为对象。提前谢谢你。

Sub FolderEmptyCellTable()

Dim Mails As Outlook.MailItem
Dim NSP As Outlook.NameSpace
Dim Folder As Outlook.MAPIFolder
Dim i As Integer
Dim WordDoc, Selection, XL, Tabl, WL, WB As Object

'Open up an Excel file
Set XL = CreateObject("Excel.Application")
XL.Visible = True
Set WB = XL.Workbooks.Open("C:\User\Desktop\Task\File.xlsx")

'Choose the export folder
Set NSP = Application.GetNamespace("MAPI")
Set Folder = NSP.PickFolder

'Run through e-mails collecting tables

For Each Mails In Folder.Items
Set WordDoc = Mails.GetInspector.WordEditor
If WordDoc.Tables.Count >= 1 Then
For i = 1 To WordDoc.Tables.Count
    Set Tabl = WordDoc.Tables(i)
    Tabl.Range.Copy
 'Insert*emphasized text* each table to a separate sheet
    Set WL = WB.Sheets(i)
    'Here is where the error 424 occurs: Object required  
    **WL.Range("a1").End(xlDown).Offset(1, 0).Select**
    Selection.Parent.PasteSpecial Format:="Text", Link:=False, _
               DisplayAsIcon:=False
 Next i

 Else: MsgBox "No tables found"
 Exit Sub

 End If

 Next Mails

 End Sub

【问题讨论】：

你去Down。您粘贴的那个单元格的地址是什么？

可能，我应该使用 .Range("A65536").End(xlUp).Select 来查找 A 列中最后使用的单元格，然后选择它下面的那个。

【参考方案1】：

这样声明：

Dim WordDoc     As Object
Dim Selection   As Object
Dim XL          As Object
Dim Tabl        As Object
Dim WL          As Worksheet
Dim WB          As Workbook

因此，您将确保它们确实是对象。在您的代码中，只有WB 是对象，其他都是Variant 类型。

【讨论】：

您好，感谢您的反馈。实际上，这正是我在文档中声明它们的方式。同意，我不应该更改此处上传代码的结构。

【参考方案2】：

感谢我的一位同事，问题已得到解决。

Sub FolderEmptyCellTable()
Dim Mails As Outlook.MailItem
Dim NSP As Outlook.NameSpace
Dim Folder As Outlook.MAPIFolder
Dim XL As Object
Dim WB As Workbook
Dim WS As Worksheet
Dim WL As Object
Dim WordDoc As Object
Dim Tabl As Object
Dim i As Integer
Dim Selection As Object

Set XL = CreateObject("Excel.Application")
XL.Visible = True
Set WB = Workbooks.Open("C:\User\Desktop\Task\File.xlsx")
Set NSP = Application.GetNamespace("MAPI")
Set Folder = NSP.PickFolder
Dim lastRow As Integer

For Each Mails In Folder.Items
Set WordDoc = Mails.GetInspector.WordEditor
If WordDoc.Tables.Count >= 1 Then
    For i = 1 To WordDoc.Tables.Count
        Set Tabl = WordDoc.Tables(i)
        Tabl.Range.Copy
        Set WS = WB.Worksheets(i)
        lastRow = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row + 1
        WS.Range("A" & lastRow).PasteSpecial Paste:=xlPasteValues
    Next i
Else
    MsgBox "No tables found"
    GoTo LabelNext
End If
LabelNext:
Next Mails
End Sub