Using group email as default sender address for Reply , Forward and New Email

[virakbot]

I have a problem with my macro for outlook. I've created VBA as below to change default sender email address in Reply , Forward and New Email. I want to use group email as default sender address for all outgoing email. But it can work fine only for New Email. It does not work in Reply and Forward email. Pls kindly help me accordingly.

Dim WithEvents objInspectors As Outlook.Inspectors
Dim WithEvents objMailItem As Outlook.MailItem
Dim WithEvents myOlExp As Outlook.Explorer

Private Sub Application_Startup()
Initialize_handler
End Sub

Public Sub Initialize_handler()
Set objInspectors = Application.Inspectors
Set myOlExp = Application.ActiveExplorer
End Sub

Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
If Inspector.CurrentItem.Class = olMail Then
    Set objMailItem = Inspector.CurrentItem
    If objMailItem.Sent = False Then
        Call SetFromAddress(objMailItem)
    End If
End If
End Sub

Public Sub SetFromAddress(oMail As Outlook.MailItem)

oMail.SentOnBehalfOfName = "abc@def.com"
End Sub

 

[paulxmw]

Hi

You mat adapt the code below which sends from a shared in box ans when people reply it reply's to the shared inbox

                With OutMail
                    .SentOnBehalfOfName = "sharedinbox@leeds.com"
                    .To = "anemail@address.co.uk"
                    .Subject = "some text"
                    .Body = StrBody & sBody 
                    .Display ' or Send
                    
                End With

 

[virakbot]

Thanks Paulxmw. Is it for replying email to only address "anemail@address.co.uk"? I want it to be as default sender for all receiver address. Is it possible? Pls kindly assist to advise accordingly.

 

[paulxmw]

Hi

Its

.SentOnBehalfOfName = "sharedinbox@leeds.com"

This is the default email address where emails are sent from and replies go back to, Just amend "sharedinbox@leeds.com" to your desired email address

Paul

 

[virakbot]

Dear Paulxmw,

Thanks you so much, but it does not work. Default sender address does not change. May you assist me any solution? thanks.

 

[paulxmw]

Hi You may wish to reconsider you code the would be a more common way of sending emails. you will see this test script gives you many possibility's amend it as needed

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


strbody = "Hi," & vbNewLine & vbNewLine & _
"We are ready to begin work on this event." & vbNewLine & _
"I will update the event details as I receive them. Please refer to this form for your event information." & vbNewLine & vbNewLine & _
"Scheduling: Could you please complete the Feedback Schedule located at:" & vbNewLine & vbNewLine



tBody = "Thank you," & vbNewLine & _
Application.UserName



On Error Resume Next

With OutMail
.SentOnBehalfOfName = "me@leeds.uk"
.To = Worksheets("Sheet1").Range("A1")
.cc = Worksheets("Sheet1").Range("B1")
.BCC = ""
.Subject = "Link to EPS for " & Worksheets("Sheet1").Range("C4") & " " & Worksheets("Sheet1").Range("C7")
.Body = strbody & hyperlinkBody & tBody
.Display


End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing

End Sub