Question

我每天运行大约 35 个文件，所有这些文件都将自己的电子邮件发送到不同的通讯组列表，具体取决于发送的报告，并且所有文件都来自已添加到我的 Outlook 的共享电子邮件帐户。我有 2 个文件，出于某种奇怪的原因，无法从我需要使用的共享电子邮件帐户发送。

**编辑：澄清一下，代码运行到完成，我可以看到电子邮件打开并快速消失，就好像电子邮件确实发送了一样。但该帐户的已发送邮件中没有任何内容发送，也没有电子邮件显示。

我在参考资料中添加了 Microsoft Outlook 16.0 对象库，并且所有文件基本上都使用相同的代码：

Public Sub sendEmail()
    Dim OutLookApp As Object, oAccount As Outlook.Account
    Dim OutLookMailItem As Object
    
    Set OutLookApp = CreateObject("Outlook.application")
    Set OutLookMailItem = OutLookApp.CreateItem(0)
    For i = 1 To Outlook.Application.Session.Accounts.Count
        Set oAccount = OutLookApp.Session.Accounts.Item(i)
        If oAccount = "notmypersonalaccount@xxx.com" Then Exit For
    Next

    With OutLookMailItem
        Set .SendUsingAccount = OutLookApp.Session.Accounts.Item(i)
        .To = "user1; user2; user3; user4; user5; " _
        & "user6; user7; user8; user9; user10; user11; " _
        & "user12; user13; user14; user15; user16; " _
        & "user17; user18; user19; user20; user21; user22"
        .CC = "user23; user24; user25"
        .BCC = ""
        .Subject = "Queue Inquiry for " & Format(Now, "m/d/yyyy") & ":"
        .Display
        .HTMLBody = "<BODY style=font-size:11pt;font-family:Cambria>Good Morning, " & "<br>" & "<br>" & _
        "Please follow the link below to view the Queue Inquiry Report for " & Format(Now, "m/d/yyyy") _
        & ". Below are the queue listings applicable for each area. This report will show you the volume in each queue and is sorted by oldest referral date (to help manage SLAs/Production)." _
        & "<br>" & "<br>" & "Fraud Queues" & "<br>" & "-   JPF" & "<br>" & "-   PFR" & "<br>" & "<br>" _
        & "C/S Back Office" & "<br>" & "-   LBX" & "<br>" & "-   SCK" & "<br>" & "-   WSN" & "<br>" & "-   TCR" & "<br>" & "-   FIC" & "<br>" & "<br>" _
        & "Dispute Resolution" & "<br>" & "-   CS1" & "<br>" & "-   APP" & "<br>" & "-   RDP" & "<br>" & "-   RTV" & "<br>" & "<br>" _
        & "Credit Bureau Disputes" & "<br>" & "-   CBD" & "<br>" & "<br>" _
        & "Credit Back Office" & "<br>" & "-   LTQ" & "<br>" & "<br>" _
        & "Collections" & "<br>" & "-   MGR" & "<br>" & "<br>" _
        & "Bankruptcy" & "<br>" & "-   LD7" & "<br>" & "-   MM4" & "<br>" & "<br>" _
        & "<a href=""https://xxxx.xx.com/xxxx/xx-xxx-xxx-xxxxxxxx/xxxxxx/xxxxx/xxxxx/xxxxx xxxxx/"">xxxxx xxxxx</a></BODY>" & .HTMLBody
        .Send
    End With
End Sub

我不明白的是，在我向发行版列表（user17 到 user22）中添加了 6 个新人之前，这个文件昨天还在运行。如果我注释掉 .SendUsingAccount = OutLookApp.Session.Accounts.Item(i)，我就可以使用我的电子邮件帐户发送。

有什么想法吗？

Answer 1

一些可能使代码更可靠的更改。

Option Explicit

Public Sub sendEmail()

    Dim OutLookApp As Object
    Dim oAccount As Outlook.account
    Dim OutLookMailItem As Object
    
    Dim srchAccount As String
    Dim i As Long
    Dim foundFlag As Boolean
    
    Set OutLookApp = CreateObject("Outlook.application")
    Set OutLookMailItem = OutLookApp.CreateItem(0)
    
    srchAccount = "notmypersonalaccount@xxx.com"
    
    For i = 1 To Session.Accounts.Count
        Set oAccount = Session.Accounts.Item(i)
        Debug.Print oAccount
        
        If oAccount = srchAccount Then
            foundFlag = True
            Exit For
        End If
    Next
    
    If foundFlag = True Then

        With OutLookMailItem
        
            Set .SendUsingAccount = oAccount
            
            ' without a subsequent .Send you can see the mail
            .Display
                        
        End With
        
    Else
    
        MsgBox srchAccount & " not found."
        
    End If
    
End Sub

从可能的原因中删除 Excel。

Option Explicit

Public Sub sendEmail_NotFromExcel()

    Dim oAccount As account
    Dim OutLookMailItem As Object
    
    Dim srchAccount As String
    Dim i As Long
    Dim foundFlag As Boolean
    
    Set OutLookMailItem = CreateItem(olMailItem)
    
    srchAccount = "notmypersonalaccount@xxx.com"
    
    For i = 1 To Session.Accounts.count
        Set oAccount = Session.Accounts.Item(i)
        Debug.Print oAccount
        
        If oAccount = srchAccount Then
            foundFlag = True
            Exit For
        End If
    Next
    
    If foundFlag = True Then

        With OutLookMailItem
        
            Set .SendUsingAccount = oAccount
            
            .Display
                        
        End With
        
    Else
    
        MsgBox srchAccount & " not found."
        
    End If
    
End Sub

无法使用 Excel VBA 中的共享邮箱发送电子邮件

1 个答案: