Question

我是VBA的新手，我遇到了一个对我没有意义的错误。我正在创建一个宏，它将进入工作簿并获取第一列中的所有条目，并使用条目作为电子邮件地址创建电子邮件。这是我的代码：

Public Sub emailList()
   'Setting up the Excel variables.
   Dim olApp As Object
   Dim olMailItm As Object
   Dim iCounter As Integer
   Dim Dest As Variant
   Dim SDest As String

   'Create the Outlook application and the empty email.
   Set olApp = CreateObject("Outlook.Application")
   Set olMailItm = olApp.CreateItem(0)

   'Using the email, add multiple recipients, using a list of addresses in column A.
   With olMailItm
       SDest = ""
       For iCounter = 1 To WorksheetFunction.CountA(Workbooks("Book1.xls").Sheets(1).Columns(1))
           If SDest = "" Then
               SDest = Cells(iCounter, 1).Value
           Else
               SDest = SDest & ";" & Cells(iCounter, 1).Value
           End If
       Next iCounter

    'Do additional formatting on the BCC and Subject lines, add the body text from the spreadsheet, and send.
       .BCC = SDest
       .Subject = "FYI"
       .Body = ActiveSheet.TextBoxes(1).Text
       .Send
   End With

   'Clean up the Outlook application.
   Set olMailItm = Nothing
   Set olApp = Nothing
End Sub

该行说：

For iCounter = 1 To WorksheetFunction.CountA(Workbooks("Book1.xls").Sheets(1).Columns(1))

抛出一个下标超出范围错误，但我在第1列有三个条目，所以我不明白为什么它会抛出一个越界错误。

Answer 1

尝试此循环，假设电子邮件地址从第2行开始。首先设置excel对象

'setup excel objects
Dim xlApp As Object
Dim WB As Workbook
Dim WS As Worksheet
Set xlApp = CreateObject("Excel.Application")
Set WB = Workbooks.Open("C:\Users\me\Desktop\Book1.xlsx")
Set WS = WB.Worksheets("Sheet1")
WB.Activate

'loop through ColA to merge email addresses
Dim last As Long
last = WS.Range("A1").CurrentRegion.Rows.Count
SDest = ""
For i = 2 To last
    SDest = SDest + Range("A" & i).Value & ";"
Next i

Answer 2

修正了错误并使其正常工作（谢谢Tim）。我没有添加一个excel对象，文件名不正确，这就是为什么它不断抛出越界错误。这是我的新代码：

Public Sub emailList()
   'Setting up the Excel variables.
   Dim olApp As Object
   Dim olMailItm As Object
   Dim iCounter As Integer
   Dim Dest As Variant
   Dim SDest As String
   Dim Excel As Object

   'Create the Outlook application and the empty email.
   Set olApp = CreateObject("Outlook.Application")
   Set olMailItm = olApp.CreateItem(0)

      'Create excel object.
   Set Excel = CreateObject("excel.application")
   Excel.Visible = True
   Excel.Workbooks.Open ("C:\Users\Deryl Lam\Documents\Book1.xlsx")
   Excel.Workbooks("Book1.xlsx").Activate

   'Using the email, add multiple recipients, using a list of addresses in column A.
   With olMailItm
       SDest = ""
       For iCounter = 1 To WorksheetFunction.CountA(Workbooks("Book1.xlsx").Sheets(1).Columns(1))
           If SDest = "" Then
               SDest = Cells(iCounter, 1).Value
           Else
               SDest = SDest & ";" & Cells(iCounter, 1).Value
           End If
       Next iCounter

    'Do additional formatting on the BCC and Subject lines, add the body text from the spreadsheet, and send.
       .BCC = SDest
       .Subject = "FYI"
       .Body = ActiveSheet.TextBoxes(1).Text
       .Send
   End With

   'Clean up the Outlook application.
   Set olMailItm = Nothing
   Set olApp = Nothing
End Sub

当试图获取列中的条目数时，下标超出范围

2 个答案: