发送到Outlook的单个Excel单元格中包含多个电子邮件地址的字符串不完整

时间:2018-01-11 13:20:45

标签: vba excel-vba outlook excel-2010 outlook-vba

我在Excel中有一个宏来通过Outlook发送电子邮件。客户改变了每个员工的机器。现在代码无法正常工作。我不能在任何机器上重现错误,而是他们的错误。

问题:单元格包含所有电子邮件地址,以“;”分隔。有时Outlook无法识别某些电子邮件,因此它会将它们留空并保留“;”!

示例:

Cell A1:test@gmail.com; test2@gmail.com; test3@gmail.com

在Outlook上显示:

To:test@gmail.com; ; test3@gmail.com

这个额外的“;”生成#5运行时错误。

Office和Windows版本是一样的,我不知道他们改变了什么。我们使用Office 2010。

  • 我试图在3台不同的机器上重现错误(甚至 使用不同的办公室版本),一切正常!
  • 我也尝试过使用早期和晚期绑定。

  • 我尝试使用Value,Value2从单元格收集电子邮件, 文字,但仍然是错误。

  • 我尝试在我的计算机上强制执行错误,让单元格保留额外的“;”,但Outlook会自动抑制额外的“;”一切正常。

以下是发送电子邮件的子资料:

Sub SendMail(ByVal cPath As Collection, ByVal i As Integer, ByVal sPOD As String, ByVal iPOD As Integer, ByVal cBL As Collection)

Dim SubError, Msg As String
On Error GoTo ErrorHandler2

Dim OutApp As Object
Dim OutMail, OutMail2, RunOutlook As Object
Dim cMensagem, cSubject As Collection

Dim sNavio, sViagem, sDirecao, sBL, sMail, sGrupoCopia, sReefer, sPath, sService, sGrupo, sVIX, sVLC_SUA, sTS1, sTS2 As String
Dim c, iFlag, iErrCount, k, j As Integer
Dim vFound As Variant

Set OutApp = GetObject(, "Outlook.Application")

On Error GoTo ErrorHandler2


'********************** GET VALUES *********************

sGrupo = "example@gmail.com.br"
sMail = ThisWorkbook.Sheets("Final").Range("O" & i).Value2


'********************** SET VALUES *********************

Set cMensagem = New Collection
Set cSubject = New Collection


cMensagem.Add "HTML MESSAGE1"
cMensagem.Add "HTML MESSAGE2"



cSubject.Add "SUBJECT1"
cSubject.Add "SUBJECT2"


'**************************** SEND E-MAIL *******************************

For c = 1 To 2


90:     Set OutMail = OutApp.CreateItem(0)
91:     With OutMail
92:         .To = sMail
93:         .SentOnBehalfOfName = sGrupo
94:         .CC = sGrupoCopia
95:         .Subject = cSubject(c)
96:         .HTMLBody = cMensagem(c)         
99:         .Attachments.Add (cPath(c)) 
104:        DoEvents
100:        .Send  
101:    End With

Next c


    Set OutMail = Nothing
    Set OutApp = Nothing

Exit Sub

我已经删除了一些不必要的代码信息,但是通过Excel / Outlook发送电子邮件的基本代码。

我希望有人知道可能导致这种奇怪错误的原因,或者是否有其他方式可以自动发送电子邮件。

0 个答案:

没有答案