Question

我正在尝试根据单元格“A”中一个单元格中的条件从“B”列中的列表填充电子邮件分发列表

Private Sub Outlook_Email（）

Dim olApp As Object
Dim olMail As Object
Dim cell As Range
Dim emailTo As String
Dim emailCC As String
Dim emailBCC As String

On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If olApp Is Nothing Then
    Set olApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0

emailTo = "To"
emailCC = "CC"
emailBCC = "BCC"

For Each cell In Range("B2:B100")
    If cell.Offset(-1, 0) = "To" Then emailTo = emailTo & cell.Value & ", "
    ElseIf cell.Offset(-1, 0) = "CC" Then emailCC = emailCC & cell.Value & ", "
    Else cell.Offset(-1, 0) = "BCC" Then emailBCC = emailBCC & cell.Value & ", "
    End If
Next

Set olMail = olApp.CreateItem(0)

With olMail
    .To = emailTo
    .cc = emailCC
    .bcc = emailBCC
    .Display
End With

End Sub

我得到的错误信息是：编译错误，其他没有If在循环中的CC行。

感谢您的帮助！

Answer 1

字符串的构造看起来有点畸形。尝试更接近这一点。

emailTo = vbNullString
emailCC = vbNullString
emailBCC = vbNullString

For Each cell In Range("B2:B100")
    Select Case LCase(cell.Offset(-1, 0).Value)
        Case "to"
            emailTo = emailTo & cell.Value & "; "
        Case "bcc"
            emailBCC = emailBCC & cell.Value & "; "
        Case "cc"
            emailCC = emailCC & cell.Value & "; "
        Case Else
            'do nothing
    End Select
Next

请注意用作电子邮件地址分隔符的分号。

Answer 2

写在一行上的

If语句被视为封闭的if块：

If cell.Offset(-1, 0) = "To" Then emailTo = emailTo & cell.Value & ", "

如果你想扩展那个带有Elses的块，你需要一个换行符：

If cell.Offset(-1, 0) = "To" Then 
   emailTo = emailTo & cell.Value & ", "
Else...

使用VBA在Outlook中自动填充To，CC，BCC字段

2 个答案: