简体   繁体   中英

Error 424 when pasting objects to an empty cell/Worksheet isn't recognized as an object

I'm fairly new to programming. Could you, please, help me identify the problem and possibly solve it. The macro below is supposed to extract tables from an e-mail folder. The first two parts work pretty well: I can open up the Excel export file and choose the email folder. However, export to the file fails as a target spreadsheet appears not to be recognized as an object. Thank you in advance.

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

Declare like this:

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

Thus, you will make sure that they are objects indeed. In your code, only WB is object, the others are of type Variant .

Thanks to a colleague of mine, the issue has been resolved.

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM