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

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

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
 
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
 
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
 
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
 
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
 
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
 
can you tell me, step by step, what i do did to run this macro?
when i try : error 91
 
Back
Top