使用自动化发送具有32位Outlook的电子邮件时出现地址错误

时间:2017-11-17 21:30:00

标签: outlook vb6 mapi

注意:在我发现outlook版本是32位而不是64位之后从原版编辑。

我有一个传统的32位VB6程序,它使用outlook 2010 32bit(完整版,非快递)来发送电子邮件。除了一台带有Windows 7(64位我假设)的机器外,在许多机器上都能完美运行。不确定所有的Windows 7机器是否都不起作用或只是这个。

如果我使用自动化技术或MAPI技术(正如我所说的那样,请参阅下面的代码),outlook会发送电子邮件,但邮件服务器会将其恢复为无法送达,说收件人不存在。

现在,如果使用自动化技术,Outlook将不显示UI,并且电子邮件将在后台发送。

然而,如果使用MAPI技术,Outlook会打开它的撰写电子邮件对话框,允许用户在发送之前编辑电子邮件。有趣的是,收件人电子邮件看起来很好,但如果发送,将无法送达。但是,如果删除并重新键入收件人,则电子邮件将成功。我相信复制和重新粘贴也可以。

这告诉我收件人的电子邮件地址中必须有一个或多个隐藏的非法字符(可能是空的?)。下面显示的代码非常简单,我无法想到任何明显的修复。 txtTo是带有电子邮件地址的vb6字符串,这是导致所有问题的字段。

错误消息:

  Your message did not reach some or all of the intended recipients.

  Subject:  a test from daryls cpu #2
  Sent: 11/17/2017 8:01 PM

  The following recipient(s) cannot be reached:

  'someemail@gmail.com' on 11/17/2017 8:01 PM
        None of your e-mail accounts could send to this recipient.

自动化技术

        Dim mOutlookApp As Object
        Set mOutlookApp = GetObject("", "Outlook.application")

        Dim olNs As Object
        Set olNs = mOutlookApp.GetNamespace("MAPI")
        olNs.Logon

        Dim OutMail As Object
        Set OutMail = mOutlookApp.CreateItem(0)

        'Set the To and Subject lines.  Send the message.
        With OutMail
            .To = txtTo
            .CC = txtCC
            .Subject = txtSubjext
            .HTMLBody = txtBody & vbCrLf

            Dim myAttachments As Object
            Set myAttachments = .Attachments
            vAttach = Split(mAttachments, ",")
            For i = 0 To UBound(vAttach)
                myAttachments.add vAttach(i)
            Next i


            Dim myFolder As Object
            Set myFolder = olNs.GetDefaultFolder(5) 'olFolderSent
            Set .SaveSentMessageFolder = myFolder

            StatusBar1.Panels(1).Text = "Status: Sending"

            .send
        End With

MAPI技术

    'Open up a MAPI session:
    With frmMain.MAPISession1
        .DownLoadMail = False
        .Username = ""
        .LogonUI = True
        .SignOn
    End With

    With frmMain.MAPIMessages1
        .SessionID = frmMain.MAPISession1.SessionID
        .Compose
        .MsgIndex = -1

        .RecipIndex = 0
        .RecipAddress = txtTo
        .RecipDisplayName = txtTo
        .RecipType = mapToList

        If txtCC <> "" Then
            .RecipIndex = 1
            .RecipDisplayName = txtCC
            .RecipAddress = txtCC
            .RecipType = mapCcList
        End If

        'spaces are important! need one space for each attachment
        'NOTE .MsgNoteText = " " MUST be there see.. KB173853 in microsoft

        .MsgSubject = txtSubjext

        .MsgNoteText = Space$(UBound(vAttach) + 1) & vbCrLf
        .MsgNoteText = txtBody & vbCrLf

        For i = 0 To UBound(vAttach)
            .AttachmentIndex = i
            .AttachmentPosition = i
            .AttachmentType = mapData
            .AttachmentName = GetFileFromPath(vAttach(i))
            .AttachmentPathName = vAttach(i)
        Next i

        StatusBar1.Panels(1).Text = "Status: Sending"

        .send True

    End With

更多信息:

我取得了一些进展。该错误与Outlook中不是SMTP的电子邮件类型有关。如果在outlook compose对话框中的发送到电子邮件中右键单击电子邮件地址,则选择outlook属性并将电子邮件类型更改为SMTP,它将起作用。显示的类型是电子邮件地址本身,有效值似乎是&#39; mailto&#39;和&#39; smtp&#39;因此,如果我可以从vb6设置电子邮件类型,则应该修复错误。

答案&#39;? https://kb.intermedia.net/article/2344

我无法相信没有解决这个问题......

1 个答案:

答案 0 :(得分:0)

解决!

我意识到这个主题很可能对20世纪的任何编程都没有兴趣,但这里有解决方法:

.RecipAddress = "SMTP:" & txtTo

它刚来找我。 :)