Macro button that saves the email I'm reading to c:\outlook as .ms

[kvpb2000]

Hi,

I want to:
1) open an email that's in my inbox
2) read the email
3) decide that I'd like to copy this email to a c:\outlook folder in Windows
Explorer
4) click on the assigned macro button at the top of the email I'm reading
and save the email that's open to c:\outlook folder in an .msg file format.

I've found code that's done this but the code I tried saves the last email
in my list of emails of my inbox and not the one that I have open. Does
anyone know how to specifically open an email so it takes up your entire
screen, read it, and then have a macro button in the same email save to a
c:\outlook folder. Here is the code that I found from someplace else that's
close, but again, it grabs the last email of my list and not the email that's
open. ( I understand that it's pulling the last email because of the
statement (Items(1)) , I just need to know how to get around that and to save
the email that's open )

Sub saveemail()

Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFLDR As Outlook.MAPIFolder
Dim objMI As Outlook.MailItem
Dim objATCH As Outlook.Attachment


Set objOL = New Outlook.Application
Set objNS = objOL.GetNamespace("MAPI")
' You need to point to the folder you want
' to save messages from on the next line:
Set objFLDR = objNS.GetDefaultFolder(olFolderInbox)
If objFLDR.Items.Count > 0 Then
Set objMI = objFLDR.Items(1)
objMI.SaveAs "C:\outlook\Temp.msg", olMSG
End If


Set objMI = Nothing
Set objFLDR = Nothing
Set objNS = Nothing
Set objOL = Nothing


End Sub

 

[Dmitry Streblechenko]

If you are reading a message in an inspector, use
Application.ActiveInspector.CurrentItem.SaveAs.
If you are reading in the preview pane, use
Application.ActiveExplorer.Selection.Item(1).SaveAs.
All error checking is omitted above of course.

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

 

[kvpb2000]

Hi Dmitry,

Thanks for the code but where in my existing code does the two lines you
mentioned fit? I tried it in the middle and the code turned red.

Application.ActiveInspector.CurrentItem.SaveAs.
Application.ActiveExplorer.Selection.Item(1).SaveAs.

Set objOL = New Outlook.Application
Set objNS = objOL.GetNamespace("MAPI")
' You need to point to the folder you want
' to save messages from on the next line:
Set objFLDR = objNS.GetDefaultFolder(olFolderInbox)

Application.ActiveInspector.CurrentItem.SaveAs.


If objFLDR.Items.Count > 0 Then
Set objMI = objFLDR.Items(1)
objMI.SaveAs "C:\outlook\Temp.msg", olMSG
End If

 

[Dmitry Streblechenko]

Set objOL = New Outlook.Application
objOL.ActiveInspector.CurrentItem.SaveAs "c:\test.msg", 3

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

 

[kvpb2000]

Thank you very much Dmitry, that worked GREAT!!!

I'm sure other people who read this blog will find that your suggestion
works excellent. Here's the finished product:

Sub saveemail()

Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFLDR As Outlook.MAPIFolder
Dim objMI As Outlook.MailItem
Dim objATCH As Outlook.Attachment


Set objOL = New Outlook.Application
Set objNS = objOL.GetNamespace("MAPI")
' You need to point to the folder you want
' to save messages from on the next line:
Set objFLDR = objNS.GetDefaultFolder(olFolderInbox)


If objFLDR.Items.Count > 0 Then
Set objMI = objFLDR.Items.Application.ActiveInspector.CurrentItem
objMI.SaveAs "C:\outlook\Temp.msg", olMSG
End If


Set objMI = Nothing
Set objFLDR = Nothing
Set objNS = Nothing
Set objOL = Nothing


End Sub

 

[Dmitry Streblechenko]

There is absolutely no reason to retrive the Inbox folder. You also need to
perform at least some sanity checks. I am alsdso not sure why you'dd ever
want to write
objFLDR.Items.Application
instead of
objOL

Dim objOL As Outlook.Application
Dim objMI As Outlook.MailItem
Dim objATCH As Outlook.Attachment

Set objOL = New Outlook.Application

If not (objOL.ActiveInspector Is Nothing) Then
Set objMI = objOL.ActiveInspector.CurrentItem
objMI.SaveAs "C:\outlook\Temp.msg", olMSG
End If


Set objMI = Nothing
Set objFLDR = Nothing
Set objNS = Nothing
Set objOL = Nothing


End Sub


Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

 

[armando cazzetta]

can you tell me, step by step, what i do did to run this macro?
when i try : error 91

*** Sent via Developersdex http://www.developersdex.com ***