通过VBA崩溃打开Outlook的原因不明

时间:2017-09-04 15:22:31

标签: excel vba excel-vba

我正在使用此代码直接在Outlook中打开电子邮件地址列表。电子邮件列表包含大约100个电子邮件地址。

如果我让代码仅运行列表的某些部分,它对所有不同的部分都可以正常工作,但只要我让它运行整个列表,我就会得到运行时错误'5。有没有人有什么建议导致这个问题?我会非常感激。

If ActiveWorkbook.Worksheets("Output").Range("I10").Value = "Wahr" Then

Dim strAddress As String
Dim lastCell As Long
Dim i As Integer

Worksheets("Output").Activate

lastCell = Range("B" & Rows.Count).End(xlUp).Row

For i = 13 To lastCell
   If strAddress = "" Then
   strAddress = Cells(i, 2).Value
Else
  strAddress = strAddress & ";" & Cells(i, 2).Value
End If
Next i

ActiveWorkbook.FollowHyperlink Address:="mailto:" & strAddress 'this line gives me the error
End If

enter image description here

编辑:奇怪的是,我选择的“团体”并不重要。这似乎是我选择了多少地址的问题。

1 个答案:

答案 0 :(得分:2)

不确定的含义我正在使用此代码直接在Outlook中打开电子邮件地址列表。

代码似乎会创建一个空白电子邮件,B13中的每个单元格向下提供电子邮件地址?

以下代码可能会有所帮助 它使用后期绑定(因此不需要引用)来获取对Outlook的引用,然后它创建一个电子邮件并在最终显示之前将电子邮件地址作为收件人添加到它。您可以将.Display更改为.Send以发送电子邮件,而不是仅显示它。

Public Sub Test()

    Dim oOL As Object
    Dim oMail As Object
    Dim rLastCell As Range
    Dim rAddRange As Range
    Dim rCell As Range

    Set oOL = CreateOL

    With ThisWorkbook.Worksheets("Output")
        Set rLastCell = .Cells(.Rows.Count, 2).End(xlUp)
        Set rAddRange = .Range("B13", rLastCell)
    End With

    Set oMail = oOL.CreateItem(0)

    With oMail
        For Each rCell In rAddRange
            .Recipients.Add rCell.Value
        Next rCell
        .Display
    End With

End Sub

Public Function CreateOL() As Object

    Dim oTmpOL As Object

    On Error GoTo ERROR_HANDLER

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Creating an instance of Outlook is different from Excel. '
    'There can only be a single instance of Outlook running,  '
    'so CreateObject will GetObject if it already exists.     '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Set oTmpOL = CreateObject("Outlook.Application")

    Set CreateOL = oTmpOL

    On Error GoTo 0
    Exit Function

ERROR_HANDLER:
    Select Case Err.Number

        Case Else
            MsgBox "Error " & Err.Number & vbCr & _
                " (" & Err.Description & ") in procedure CreateOL."
            Err.Clear
    End Select

End Function