Outlook reply code help needed please

[mrshl9898]

Hi,

Our company has disabled Reply All. And shortcuts no longer work as an alternative. I am ok with VBA in Excel but unfamiliar with Outlook.

I've tried the below tests, but nothing happens.

I think I need to create a new email and add the original recipients and cc's manually.

How would I go about this?

Sub ReplyToAll_Run()

If Application.ActiveExplorer.Selection.Count >= 1 Then
    Dim o As Object
    Set o = Application.ActiveExplorer.Selection.Item(1)
    If TypeName(o) = "MailItem" Then
        Dim mi As MailItem
        Set mi = o
        mi.replyall
        Exit Sub
    End If
End If
MsgBox "Cannot Reply to All when no mail items are selected"
End Sub




Sub test()


Dim o As MailItem
Set o = Application.ActiveExplorer.Selection.Item(1)
o.replyall


End Sub

Many thanks!

 

[mrshl9898]

I've managed to get the recipients and subject for the new email. Just need to create the item and add these, any ideas?

Sub reciplist()

Dim OutlookMessage As Outlook.MailItem
Dim AppOutlook As New Outlook.Application
Dim sendtolist As String
Dim subjectstring As String
Dim ppls As Recipients
Dim d As Long


'get recipients from selected
Dim o As MailItem
Set o = Application.ActiveExplorer.Selection.Item(1)
For d = 1 To o.Recipients.Count
Debug.Print o.Recipients.Item(d).Name


If d = 1 Then
sendtolist = o.Recipients.Item(d).Name
Else
sendtolist = sendtolist & " ;" & o.Recipients.Item(d).Name
End If


Next d


'get subject from seleted
subjectstring = o.Subject


End Sub

 

[mrshl9898]

Solution, thanks for anyone looking into it. (didn't realize it would be so easy)

Sub ReplytoAll()

Dim OutlookMessage As Outlook.MailItem
Dim AppOutlook As New Outlook.Application
Dim sendtolist As String
Dim subjectstring As String
Dim ppls As Recipients
Dim d As Long
Dim o As MailItem


'get recipients from selected
Set o = Application.ActiveExplorer.Selection.Item(1)
    For d = 1 To o.Recipients.Count
        If d = 1 Then
        sendtolist = o.Recipients.Item(d).Name
        Else
        sendtolist = sendtolist & " ;" & o.Recipients.Item(d).Name
        End If
    Next d


'get subject from seleted
    subjectstring = o.Subject


'create and send
Set myItem = Application.CreateItem(olMailItem)
    With myItem
    .Display
    .To = sendtolist
    .Subject = subjectstring
    End With




End Sub