使用VBA从Outlook输出到Outlook

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

行本身是指activeSheet在Excel中。你需要限定它。取而代之的

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

使用

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