無法使用來自 Excel VBA 的共享郵箱發送 email

Question

我每天運行大約 35 個文件，所有這些文件都將自己的 email 發送到不同的分發列表，具體取決於發送的報告，並且所有文件都來自共享的 email 帳戶，該帳戶已添加到我的 Z038E648F69B23AFB2A2D48D1。 我有 2 個文件，出於某種奇怪的原因，它們不會從我需要使用的共享 email 帳戶發送。

**編輯：澄清一下，代碼運行完成，我可以看到 email 打開並迅速消失，好像 email DID 發送一樣。 但是沒有發送任何內容，也沒有 email 顯示在該帳戶的已發送項目中。

我在我的參考文獻中添加了 Microsoft Outlook 16.0 Object 庫，所有文件基本上都使用相同的代碼：

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

我沒有得到的是這個文件昨天還在工作，在我將 6 個新人添加到發行版列表之前，從 user17 到 user22。 如果我注釋掉.SendUsingAccount = OutLookApp.Session.Accounts.Item(i)我可以使用我的 email 帳戶發送。

有什么想法嗎？

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 的共享郵箱發送 email

問題描述

1 個解決方案

解決方案1
0 2021-02-15 13:34:09

無法使用來自 Excel VBA 的共享郵箱發送 email

問題描述

1 個解決方案

解決方案1 0 2021-02-15 13:34:09

解決方案1
0 2021-02-15 13:34:09