Excel 运行时错误'；1004'；方法'；行'；对象的'_全球'；失败

我是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

子ExportToExcel（）
Dim appExcel作为Excel.Application
将wkb设置为Excel.工作簿
Dim以Excel格式工作。工作表
尺寸为Excel.Range
将标准表变暗为字符串
将strPath设置为字符串
作为整数的Dim intRowCounter
Dim intColumnCounter作为整数
将消息作为Outlook.mailtim
将nms设置为Outlook.NameSpace
将fld设置为Outlook.Mapi文件夹
将itm调暗为对象
Dim masterData（）作为字符串
将子数据（）设置为字符串
作为整数的Dim i
变暗与变长
strSheet=“For fun.xlsx”
strPath=“C:\Users\XXXXX\Desktop\New folder\”
strSheet=strPath和strSheet
设置nms=Application.GetNamespace（“MAPI”）
设置fld=nms.PickFolder
'使用“选择文件夹”对话框处理潜在错误。
如果fld不算什么，那么
MsgBox“感谢您使用此服务”，vbOKOnly，“错误”
出口接头
ElseIf fld.DefaultItemType olMailItem然后
MsgBox“请选择正确的文件夹”，vbOKOnly，“错误”
出口接头
ElseIf fld.Items.Count=0，则
MsgBox“没有要导出的邮件”，vbOKOnly，“错误”
出口接头
如果结束
'打开并激活Excel工作簿。
设置appExcel=CreateObject（“Excel.Application”）
appExcel.Workbooks.Open（标准表格）
设置wkb=appExcel.ActiveWorkbook
设置wks=wkb图纸（“图纸1”）
工作。激活
appExcel.Application.Visible=True
'复制邮件文件夹中的字段项目。
对于fld.项目中的每个itm
设置msg=itm
主数据=拆分（msg.Body，vbCrLf）'根据行分开
对于i=0到uBond（主数据）
如果主数据（i）=“则
“什么也不做
其他的
“在这里分开吗
子数据=拆分（主数据（i），vbTab）
工作。激活
offsetRow=单元格（Rows.Count，1）。End（xlUp）。Row'这是出现错误的位置
如果i=0，那么
导入计数器=i+偏移计数器+1
其他的
输入计数器=输入+输出计数器
如果结束
对于intColumnCounter=0到UBound（子数据）
设置rng=wks.Cells（intRowCounter、intColumnCounter+1）
rng.Value=子数据（intColumnCounter）
下一列计数器
如果结束
接下来我
下一个itm
设置appExcel=Nothing
设置wkb=无
设为零
设置rng=无
设置msg=Nothing
设置nms=无
设置fld=无
设置itm=无
端接头

您的问题是因为您没有限定Excel范围引用

改变

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

到

---

顺便说一句，可以对此代码进行很多优化

您的问题是因为您没有限定Excel范围引用

改变

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

到

顺便说一句，可以对该代码进行很多优化

我更改了：

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

进入

现在可以用了。

我更改了：

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

进入

---

现在它可以工作了。

试试这个

offsetRow=wks.Cells（wks.Rows.Count，1）。End（-4162）。Row

试试这个

offsetRow=wks.Cells（wks.Rows.Count，1）。End（-4162）。Row

@Siddharth-没有看到你的评论，你发帖时我可能还在打字。（关于

-4162

）不用担心Chris:）+1来解释：）顺便说一句，如果OP正在进行早期绑定，那么您也可以使用

xlUp

。我出于习惯写了

-4162

：）谢谢克里斯和西德哈特的帮助。无论如何，在发布这个问题1小时后，我已经计算出来了，但由于7小时规则，我不能发布我的答案。不管怎么说，这是一个“with”语句。那么关于代码的优化，你有什么建议？@Siddharth-没有看到你的评论，我可能在你发帖时还在打字。（关于

-4162

）不用担心Chris:）+1来解释：）顺便说一句，如果OP正在进行早期绑定，那么您也可以使用

xlUp

。我出于习惯写了

-4162

：）谢谢克里斯和西德哈特的帮助。无论如何，在发布这个问题1小时后，我已经计算出来了，但由于7小时规则，我不能发布我的答案。不管怎么说，这是一个“with”语句。那么关于代码的优化，你有什么建议呢？优化的可能性在Chris Neilsen的回答中：保存两行完全相同的代码：）优化的可能性在Chris Neilsen的回答中：保存两行完全相同的代码：）