Output to Excel from Outlook using VBA

2019-09-12 22:36发布

I have a VBA script sitting in Outlook that attempts to grab information from email items and write it to an Excel file. I'm pretty new to VBA, so after much debugging and editing, I've managed to get something that mostly works, but I could use a little guidance. I'll explain my script and then talk about my problem.

I've included my full script at the end. Here is a quick outline of it, where I include the parts that I think might need some work.

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

When I run this script, it updates my excel file correctly, producing results like:

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

I can even run it multiple times and it appends to the file without issue:

+ - + ------- + --------------- + -------- + - +
| 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 |
+ - + ------- + --------------- + -------- + - +

So up to here, everything works

Here's the problem:

I open the excel file to look at the results. I close it without any modifications. Then, I try to run the script again in VBA, and I get the following error:

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

The debugger highlights the line

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

I'm really not sure what's causing this error since it happens only when I open the excel file to check the results. I think the VBA script might be opening and closing the file incorrectly, but the resources I've used indicate that this is the right way to do it. One solution may be to never open the file, but that's unreasonable.

Any thoughts or insights as to what may be going on here?


More Detailed script below:

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

1条回答
姐就是有狂的资本
2楼-- · 2019-09-12 22:55

Rows by itself refers to the activeSheet in Excel. You need to qualify it. Instead of

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

use

RowNext = xlSheet.Cells(xlSheet.Rows.Count, "A").End(xlUp).Row + 1
查看更多
登录 后发表回答