查找下一个可用行 [英] Find next available row

问题描述

我在Outlook中有一个VBA脚本，试图从电子邮件项中获取信息并将其写入Excel文件.

I have a VBA script in Outlook that attempts to grab information from email items and write it to an Excel file.

我在结尾处加上了完整的脚本.这是一个简短的概述，其中包括我认为可能需要一些工作的部分.

I included my full script at the end. Here is a quick outline, 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

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

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

这是问题所在:

我打开Excel文件查看结果.我将其关闭而没有任何修改.然后，我尝试再次在VBA中运行该脚本，并且出现以下错误:

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:

运行时错误'1004':
对象"_Global"的方法行"失败

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

调试器突出显示该行

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

仅当我打开Excel文件检查结果时，才会发生此错误.我认为VBA脚本可能无法正确打开和关闭文件，但是我使用的资源表明这是正确的方法.

This error 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.

更详细的脚本:

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.您需要限定它.代替

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

使用

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

这篇关于查找下一个可用行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！