使用VBA从Outlook输出到Excel
我有一个坐在Outlook中的VBA脚本，试图从电子邮件中获取信息并将其写入Excel文件。 我对VBA相当陌生，经过很多debugging和编辑之后，我设法find了一些大部分可行的东西，但我可以使用一些指导。 我会解释我的脚本，然后谈论我的问题。
我已经包括我的完整脚本在最后。 这里有一个简要的概述，其中包括我认为可能需要一些工作的部分。
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文件来查看结果。 我没有任何修改就closures它。 然后，我尝试在VBA中再次运行该脚本，出现以下错误：
Run-time error '1004': Method 'Rows' of object '_Global' failed
debugging器突出显示该行
RowNext = xlSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 ' <- This line highlighted by debugger
我真的不知道是什么原因导致这个错误，因为只有当我打开Excel文件来检查结果时才会发生。 我认为VBA脚本可能会打开和closures文件不正确，但是我使用的资源表明这是正确的方法。 一个解决scheme可能是永远不打开文件，但这是不合理的。
对这里可能发生的事情有任何想法或见解？
下面更详细的脚本：
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
行本身是指Excel中的activeSheet。 你需要限定它。 代替
RowNext = xlSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
使用
RowNext = xlSheet.Cells(xlSheet.Rows.Count, "A").End(xlUp).Row + 1