運行時錯誤“1004”對象“_Global”的方法“行”失敗

Question

我是 VBA 新手，因為我剛剛開始學習它。

現在我在將郵件正文從 Outlook 導出到 excel 時遇到問題。 有趣的是，當我第一次運行時，它就起作用了。 但是當我第二次運行時，會出現我標題中所述的錯誤消息。

我點擊了調試，它突出顯示了這段代碼：“offsetRow = Cells(Rows.Count, 1).End(xlUp).Row”

我嘗試了各種方法，比如選擇我想將數據粘貼到其中的工作表，但無濟於事。 所以，希望這里的高手能幫我調試一下代碼。 如果我做了任何會減慢計算機速度的冗余，也可以隨時反饋我的編碼。

僅供參考，這是為了我的工作，以便我可以將電子郵件內容導出到 Excel 中。 提前致謝。

Sub ExportToExcel()

Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rng As Excel.Range
Dim strSheet As String
Dim strPath As String
Dim intRowCounter As Integer
Dim intColumnCounter As Integer
Dim msg As Outlook.MailItem
Dim nms As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder
Dim itm As Object
Dim masterData() As String
Dim subData() As String
Dim i As Integer
Dim offsetRow As Long

strSheet = "For fun.xlsx"
strPath = "C:\Users\XXXXX\Desktop\New folder\"
strSheet = strPath & strSheet

Set nms = Application.GetNamespace("MAPI")
Set fld = nms.PickFolder

'Handle potential errors with Select Folder dialog box.
If fld Is Nothing Then
    MsgBox "Thank you for using this service.", vbOKOnly, "Error"
    Exit Sub
ElseIf fld.DefaultItemType <> olMailItem Then
    MsgBox "Please select the correct folder.", vbOKOnly, "Error"
    Exit Sub
ElseIf fld.Items.Count = 0 Then
    MsgBox "There are no mail messages to export", vbOKOnly, "Error"
    Exit Sub
End If

'Open and activate Excel workbook.
Set appExcel = CreateObject("Excel.Application")
    appExcel.Workbooks.Open (strSheet)
Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.Sheets("Sheet1")

wks.Activate
appExcel.Application.Visible = True  

'Copy field items in mail folder.
For Each itm In fld.Items
    Set msg = itm
    masterData = Split(msg.Body, vbCrLf) 'Seperate according to lines
    For i = 0 To UBound(masterData)
        If masterData(i) = "" Then
            'Do nothing
        Else
            'do the split here
            subData = Split(masterData(i), vbTab)
            wks.Activate
            offsetRow = Cells(Rows.Count, 1).End(xlUp).Row 'This is where the error appears
            If i = 0 Then
                intRowCounter = i + offsetRow + 1
            Else
                intRowCounter = i + offsetRow
            End If
            For intColumnCounter = 0 To UBound(subData)
                Set rng = wks.Cells(intRowCounter, intColumnCounter + 1)
                rng.Value = subData(intColumnCounter)
            Next intColumnCounter
        End If
    Next i
Next itm

Set appExcel = Nothing
Set wkb = Nothing
Set wks = Nothing
Set rng = Nothing
Set msg = Nothing
Set nms = Nothing
Set fld = Nothing
Set itm = Nothing

End Sub

Answer 1

您的問題是因為您沒有限定 Excel 范圍引用

改變

offsetRow = Cells(Rows.Count, 1).End(xlUp).Row 'This is where the error appears

至

offsetRow = wks.Cells(wks.Rows.Count, 1).End(-4162).Row 

順便說一句，可以對此代碼進行很多優化

Answer 2

我改變了：

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

進入

With wks
    offsetRow = .Cells(.Rows.Count, 1).End(xlUp).Row
End With

現在可以了。