使用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