Can some one please help me, I didn't wrote this macro but searched over Google and trying to make it work as I am needed, it doesn't even copy the replied email
I want to Run a macro on current opened email that it will do reply and then copy full email body and open and paste it in new mail where To , CC and Subject would be same as of reply email.
Will really appreciate if somebody can help me sorting out this macro
Sub Old_reply()
Dim objApp
Dim objInsp
Dim colCB
Dim objCBB
Dim Mail As Outlook.MailItem
On Error Resume Next
Set objApp = GetObject("", "Outlook.Application")
If objApp Is Nothing Then
Set objApp = Application.CreateObject("Outlook.Application")
End If
Set objInsp = objApp.ActiveInspector.CurrentItem
If TypeName(objInsp) = "Nothing" Then
MsgBox "No inspector window found"
Exit Sub
Else
Set colCB = objInsp.CommandBars
Set objCBB = colCB.FindControl(, 354) ' Reply
objCBB.Execute
Set objInsp = Nothing
Set colCB = Nothing
Set objInsp = objApp.ActiveInspector.CurrentItem
Set colCB = objInsp.CommandBars
Set objCBB = colCB.FindControl(, 3634) ' clear clipboard
objCBB.Execute
Set objCBB = colCB.FindControl(, 756) ' select all
objCBB.Execute
Set objCBB = colCB.FindControl(, 19) ' copy
objCBB.Execute
Set Mail = Outlook.CreateItem(olMailItem)
Mail.To = objInsp.To
Mail.CC = objInsp.CC
Mail.Subject = objInsp.Subject
objInsp.Body = Mail.Body
Mail.Display
Set objCBB = colCB.FindControl(, 22) ' paste
objCBB.Execute
Set Mail = Nothing
End If
End Sub
I want to Run a macro on current opened email that it will do reply and then copy full email body and open and paste it in new mail where To , CC and Subject would be same as of reply email.
Will really appreciate if somebody can help me sorting out this macro
Sub Old_reply()
Dim objApp
Dim objInsp
Dim colCB
Dim objCBB
Dim Mail As Outlook.MailItem
On Error Resume Next
Set objApp = GetObject("", "Outlook.Application")
If objApp Is Nothing Then
Set objApp = Application.CreateObject("Outlook.Application")
End If
Set objInsp = objApp.ActiveInspector.CurrentItem
If TypeName(objInsp) = "Nothing" Then
MsgBox "No inspector window found"
Exit Sub
Else
Set colCB = objInsp.CommandBars
Set objCBB = colCB.FindControl(, 354) ' Reply
objCBB.Execute
Set objInsp = Nothing
Set colCB = Nothing
Set objInsp = objApp.ActiveInspector.CurrentItem
Set colCB = objInsp.CommandBars
Set objCBB = colCB.FindControl(, 3634) ' clear clipboard
objCBB.Execute
Set objCBB = colCB.FindControl(, 756) ' select all
objCBB.Execute
Set objCBB = colCB.FindControl(, 19) ' copy
objCBB.Execute
Set Mail = Outlook.CreateItem(olMailItem)
Mail.To = objInsp.To
Mail.CC = objInsp.CC
Mail.Subject = objInsp.Subject
objInsp.Body = Mail.Body
Mail.Display
Set objCBB = colCB.FindControl(, 22) ' paste
objCBB.Execute
Set Mail = Nothing
End If
End Sub