Question

我在Outlook中有一个VBA脚本，它试图从电子邮件项中获取信息并将其写入Excel文件。我对VBA很新，所以经过大量的调试和编辑后，我已经设法获得了大部分工作，但我可以使用一些指导。我将解释我的剧本，然后谈谈我的问题。

我最后包含了我的完整脚本。以下是它的简要概述，其中包括我认为可能需要一些工作的部分。

Sub Output2Excel()
    Dim xlApp As Object
    Dim xlWkBk As Object
    Dim xlSheet As Object

    ' Setup the Excel Application
    Set xlApp = Application.CreateObject("Excel.Application")
    Set xlWkBk = xlApp.Workbooks.Open(PathName & FileName, , False) ' Open the Excel file to be updated
    Set xlSheet = xlWkBk.Worksheets(1)


    ' Loop over all the olMail items in FolderTgt, which is a MAPIFolder type
    RowNext = xlSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 ' <- This line highlighted by debugger (see below)
    ' Write stuff to Excel like
    ' For
        xlSheet.Cells(RowNext , Col).Value = [Whatever Item I want out of FolderTgt]
        RowNext = RowNext + 1
    ' Next


    ' Done with the loop, now save the file and close things down
    xlWkBk.Save
    Set xlSheet = Nothing
    xlWkBk.Close
    Set xlWkBk = Nothing
    xlApp.Quit
    Set xlApp = Nothing

    Debug.Print "All Done"
End Sub

当我运行此脚本时，它会正确更新我的excel文件，产生如下结果：

+ - + ------- + --------------- + -------- + - +
| 2 | Sender1 | SomeSubject     | 04/13/17 | 0 |
| 3 | Sender2 | AnotherSubject  | 04/13/17 | 0 | 
| 4 | Sender3 | RE: SomeSubject | 04/13/17 | 0 |
+ - + ------- + --------------- + -------- + - +

我甚至可以多次运行它并且它会附加到文件中而不会出现问题：

+ - + ------- + --------------- + -------- + - +
| 2 | Sender1 | SomeSubject     | 04/13/17 | 0 |
| 3 | Sender2 | AnotherSubject  | 04/13/17 | 0 | 
| 4 | Sender3 | RE: SomeSubject | 04/13/17 | 0 |
| 2 | Sender1 | SomeSubject     | 04/13/17 | 0 |
| 3 | Sender2 | AnotherSubject  | 04/13/17 | 0 | 
| 4 | Sender3 | RE: SomeSubject | 04/13/17 | 0 |
| 2 | Sender1 | SomeSubject     | 04/13/17 | 0 |
| 3 | Sender2 | AnotherSubject  | 04/13/17 | 0 | 
| 4 | Sender3 | RE: SomeSubject | 04/13/17 | 0 |
+ - + ------- + --------------- + -------- + - +

到目前为止，一切正常

问题在于：

我打开excel文件来查看结果。我关闭它没有任何修改。然后，我尝试在VBA中再次运行脚本，我收到以下错误：

Run-time error '1004':
Method 'Rows' of object '_Global' failed

调试器突出显示该行

RowNext = xlSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 ' <- This line highlighted by debugger

我真的不确定是什么导致了这个错误，因为它只在我打开excel文件检查结果时才会发生。我认为VBA脚本可能会错误地打开和关闭文件，但我使用的资源表明这是正确的方法。一种解决方案可能是永远不要打开文件，但这是不合理的。

关于这里可能会发生什么的任何想法或见解？

下面有更详细的脚本：

Sub Output2Excel()

    Dim FolderNameTgt As String
    Dim PathName As String
    Dim FileName As String

    Dim FolderTgt As MAPIFolder

    Dim xlApp As Object
    Dim xlWkBk As Object
    Dim xlSheet As Object

    Dim RowNext As Integer
    Dim InxItemCrnt As Integer
    Dim FolderItem As Object


    ' Outlook folder, computer directory, and excel file involved in the
        reading and writing
    FolderNameTgt = "MyUserId|Testing VBA"
    PathName = "N:\Outlook Excel VBA\"
    FileName = "Book1.xls"


    ' Locate the Folder in Outlook. I've left out some of the details here
        because this part works fine
    Call FindFolder(FolderTgt, FolderNameTgt, "|")
    If FolderTgt Is Nothing Then
        Debug.Print FolderNameTgt & " not found"
        Exit Sub
    End If

    ' Setup the Excel Application
    Set xlApp = Application.CreateObject("Excel.Application")
    Set xlWkBk = xlApp.Workbooks.Open(PathName & FileName, , False)    
    Set xlSheet = xlWkBk.Worksheets(1)


    ' Loop over all the items in FolderTgt
    RowNext = xlSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
    For InxItemCrnt = 1 To FolderTgt.Items.Count

        ' Set and use the referenced item
        Set FolderItem = FolderTgt.Items.Item(InxItemCrnt)

        ' If the Item is of the olMail class, then extract information and
            write it to excel
        If FolderItemClass = olMail Then
            xlSheet.Cells(RowNext, 1).Value = RowNext
            xlSheet.Cells(RowNext, 2).Value = FolderItem.SenderName
            xlSheet.Cells(RowNext, 3).Value = FolderItem.Subject
            xlSheet.Cells(RowNext, 4).Value = FolderItem.ReceivedTime
            xlSheet.Cells(RowNext, 4).NumberFormat = "mm/dd/yy"
            xlSheet.Cells(RowNext, 5).Value = FolderItem.Attachments.Count
            RowNext = RowNext + 1
        End If

    Next InxItemCrnt

    ' Done with the loop, now save the file and close things down
    xlWkBk.Save 'FileName:=PathName & FileName
    Set xlSheet = Nothing
    xlWkBk.Close
    Set xlWkBk = Nothing
    xlApp.Quit
    Set xlApp = Nothing

    Debug.Print "All Done"
End Sub

Answer 1

行本身是指Excel中的activeSheet。你需要对它进行鉴定。而不是

RowNext = xlSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1

使用

RowNext = xlSheet.Cells(xlSheet.Rows.Count, "A").End(xlUp).Row + 1

使用VBA从Outlook输出到Excel

1 个答案: