时间戳

首页 > 解决方案 > 查找最后一行会引发 object required 错误

excel - 查找最后一行会引发 object required 错误

问题描述

我正在尝试做的事情。

  1. 我突出显示电子邮件中的一些文本，然后运行我的宏。
  2. 它“复制”突出显示的文本并将其存储在变量 strText 中。
  3. 然后它会创建一个名为 Artwork List.xlsx 的文件，如果它不存在，如果存在则打开它。
  4. 之后，如果 lastrow 为 1，它将文本复制到 A 列第 1 行的文件中，如果不是，则附加到 lastrow + 1

我的代码抛出

'运行时错误 424，需要对象'

为了缩小范围，错误应该来自：

lastrow = .Cells(Rows.Count, 1).End(xlUp).Row

或与此行相关的任何内容。

Sub copyArts2File()
MsgBox "ok"
Dim OutApp As Object
Dim OutMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim strText As String

Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object

Dim strTextArr As Variant

On Error Resume Next
'Get Outlook if it's running
Set OutApp = GetObject(, "Outlook.Application")

'Outlook wasn't running, so cancel
If Err <> 0 Then
    MsgBox "Outlook is not running so nothing can be selected!"
    GoTo lbl_Exit
End If
On Error GoTo 0

Set OutMail = OutApp.ActiveExplorer.Selection.Item(1)
With OutMail
    Set olInsp = .GetInspector
    Set wdDoc = olInsp.WordEditor
    strText = wdDoc.Application.Selection.Range.Text
End With
'MsgBox strText

lbl_Exit:
Set OutMail = Nothing
Set OutApp = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False

FileName = "Artwork List.xlsx"
fileDoesExist = Dir("C:\Users\quaer\Desktop\DL Arts\" & FileName) > ""

' Check for existing file
If fileDoesExist Then
    ' Open Excel file
    Set xlBook = xlApp.Workbooks.Open("C:\Users\quaer\Desktop\DL Arts\" & FileName)
    Set xlSheet = xlBook.Sheets(1)
Else
    ' Add Excel file
    Set xlBook = xlApp.Workbooks.Add
    With xlBook
        .SaveAs FileName:="C:\Users\quaer\Desktop\DL Arts\" & FileName
    End With
    Set xlSheet = xlBook.Sheets(1)
End If

' Do stuff with Excel workbook
Dim i As Integer
Dim lastrow As Long
With xlApp
    With xlBook
        With xlSheet
        strTextArr = Split(strText, "Adding file")
        lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
        MsgBox lastrow
        If lastrow = 1 Then

            For i = 1 To UBound(strTextArr)
                .Range("A" & i).Value = strTextArr(i)
            Next i

        Else
            For i = 1 To UBound(strTextArr)
                .Range("A" & (i + lastrow)).Value = strTextArr(i)
            Next i

        End If
        .Close SaveChanges:=True
        End With
    End With
End With
xlApp.Visible = True
Exit Sub
End Sub

标签： excelvba

解决方案

天哪，这太疯狂了。我终于找到了问题，并为任何想要类似用法的人提供了一个工作代码。首先，我需要添加 Microsoft excel 插件。所以在 Outlook VBA 中，工具 -> 参考 -> 检查 Microsoft Excel 16.0 对象库。这是为了摆脱 424 object required 错误，因为我试图调用我猜的内置方法的 excel。这是行：

lastrow = .Cells(Rows.Count, 1).End(xlUp).Row

请注意，我是从 Outlook 调用此宏。

在此之后，我遇到了其他几个问题。1.运行时出现424、远程服务器机器不存在或不可用等错误。第一次运行，它会抛出这个错误，第二次点击，问题就消失了。这是应用程序、书籍和工作表的非特定使用的问题，因此让 VBA 自行分配。吸取教训，对每件事都要明确。

  1. 即使在程序结束后也会留下一份 excel 进程的副本。这可以在任务管理器中看到。这会导致问题，因为我的 excel 文件链接到此进程，并且在没有只读或通知的情况下无法打开。它与进程锁定。所以下次我不能再跑了。

反正。这是最终的代码。而且我也将其更改为 .Range 而不是 .Cells。我相信如果我使用任何一个都没有关系，但关键的罪魁祸首是：xlSheet.Rows.Count。明确地使用 xlSheet.Rows.Count，而不仅仅是 Rows.Count。

Option Explicit

Sub copyArts2File()
MsgBox "ok"
Dim OutApp As Object, OutMail As Object, olInsp As Object, wdDoc As Object
Dim xlApp As Excel.Application, xlBook As Excel.Workbook, xlSheet As Object
Dim strText As String
Dim strTextArr As Variant
Dim fName As String
Dim fileDoesExist As Boolean
Dim i As Integer
Dim lastrow As Long

On Error Resume Next
'Get Outlook if it's running
Set OutApp = GetObject(, "Outlook.Application")

'Outlook wasn't running, so cancel
If Err <> 0 Then
    MsgBox "Outlook is not running so nothing can be selected!"
    GoTo lbl_Exit
End If
On Error GoTo 0

Set OutMail = OutApp.ActiveExplorer.Selection.Item(1)
With OutMail
    Set olInsp = .GetInspector
    Set wdDoc = olInsp.WordEditor
    strText = wdDoc.Application.Selection.Range.Text
End With
'MsgBox strText
'Close out all shit
Set OutMail = Nothing
Set OutApp = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing

lbl_Exit:
Set OutMail = Nothing
Set OutApp = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing

On Error Resume Next 'Create or use a Excel Application
Set xlApp = GetObject(, "Excel.Application")
If Err.Number > 0 Then Set xlApp = CreateObject("Excel.Application")
On Error GoTo 0

xlApp.Visible = False
xlApp.DisplayAlerts = False

fName = "Artwork List.xlsx"
fileDoesExist = Dir("C:\Users\quaer\Desktop\DL Arts\" & fName) > ""

' Check for existing file
If fileDoesExist Then
    ' Open Excel file if present
    Set xlBook = xlApp.Workbooks.Open("C:\Users\quaer\Desktop\DL Arts\" & fName)
Else
    ' Add Excel file if not present
    Set xlBook = xlApp.Workbooks.Add
    xlBook.SaveAs fileName:="C:\Users\quaer\Desktop\DL Arts\" & fName
End If
Set xlSheet = xlBook.Worksheets(1)


' Do stuff with Excel workbook
strTextArr = Split(strText, "Adding file")
lastrow = xlSheet.Range("A" & xlSheet.Rows.Count).End(xlUp).Row
If lastrow = 1 Then

    For i = 1 To UBound(strTextArr)
        xlSheet.Range("A" & i).Value = strTextArr(i)
    Next i

Else
    For i = 1 To UBound(strTextArr)
        xlSheet.Range("A" & (i + lastrow)).Value = strTextArr(i)
    Next i

End If


xlBook.SaveAs fileName:="C:\Users\quaer\Desktop\DL Arts\" & fName, AccessMode:=xlExclusive, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
xlBook.Close (True)

Set xlBook = Nothing
Set xlSheet = Nothing
xlApp.Visible = True
xlApp.Quit

Set xlApp = Nothing

MsgBox "Done!"
Exit Sub
End Sub

尽管如此，还是感谢您的帮助和建议。

推荐阅读