Question

我正在尝试使用VBA在Outlook 2010中加载项目时更改“发件人”帐户。我有两个帐户，一个Gmail帐户和一个POP3。

回复时，全部回复，并将Outlook默认转发到收到电子邮件的帐户。如果我通过Gmail收到电子邮件，我想回复POP3帐户。即使我的默认帐户是POP3帐户，Outlook也会将其更改为Gmail。

这是我到目前为止所拥有的。不幸的是我收到错误：运行时错误'-6936698555（d6a70005）'：您没有相应的权限来执行此操作。

Private Sub Application_ItemLoad(ByVal Item As Object)
    Set myObj = GetCurrentItem()
    If TypeName(myObj) = "MailItem" Then
        Set OutApp = CreateObject("Outlook.Application")
        Set oMail = OutApp.CreateItem(olMailItem)
        Dim oAccount As Outlook.Account

        Set oMail = myObj

        oMail.SendUsingAccount = oMail.SendUsingAccount.Session.Accounts.Item(1)
    End If
End Sub


Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application

    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
    End Select

    Set objApp = Nothing
End Function

我是否通过项目加载以正确的方式进行此操作？为什么我没有权限更改发件人？是因为VB没有创建电子邮件吗？

Answer 1

我参加这个派对的时间已经很晚了，但是我试图做一些非常相似的事情，并且遇到了你的问题/代码。我设法让它发挥作用。

问题是GetCurrentItem（）从收件箱（或任何地方）返回邮件项目。您需要修改的是通过点击“回复”创建的新消息。

我拿了你的代码并修改了它。我添加了一个更改事件来更改响应的SendUsingAccount属性。 ItemLoad事件检查当前邮件项的“To”属性，以决定是否设置回复事件。

Public WithEvents SecondAcctMsg As MailItem

Private Sub Application_ItemLoad(ByVal Item As Object)
    Set myObj = GetCurrentItem()
    If TypeName(myObj) = "MailItem" Then
        Select Case myObj.To
            Case "<relevant email address>"

                Set SecondAcctMsg = myObj

        End Select
    End If
End Sub


Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application

    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"

            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"

            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
    End Select

    Set objApp = Nothing
End Function

Private Sub SecondAcctMsg _Reply(ByVal Response As Object, Cancel As Boolean)

   ' Change Accounts index to relevant account
    Response.SendUsingAccount = Application.Session.Accounts(2)

End Sub

Answer 2

我认为应该使用以下内容设置mailitem：

Set oMail = OutApp.CreateItem(olMailItem)

并设置应用程序应使用：

Set OutApp = CreateObject("Outlook.Application")

如果展望未开启，则如果是：

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

我没有使用过SendUsingAccount，我猜您需要将帐户设置为您的备用帐户。我使用过SendOnBehalfOfName也许这会起作用。

oMail.SentOnBehalfOfName = "Your POP3 account name"
oMail.Send

Outlook VBA更改项目加载时使用帐户发送

2 个答案: