1

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

2 回答 2

6

您的问题是因为您没有限定 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

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

于 2013-01-05T05:14:12.913 回答
1

我改变了：

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

进入

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

现在可以了。

于 2013-01-06T02:47:41.320 回答