Saving e-mail as HTML by rule (newbie question)

[Lester]

I am trying to automatically save an incoming e-mail as html when it
arrives. No rule will do that. The following code works fine:

Sub canslim()
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.ActiveInspector.CurrentItem
myItem.SaveAs "U:\Auxiliaries\" & "CSToday.htm", olHTML
End Sub

But I have to manually open the e-mail and then call the macro.
Any ideas?

 

[Michael Bauer]

Hi Lester,

copy the code in "ThisOutlookSession". It works if the mail is really an
html mail and the direction in sPath exists already:

<ThisOutlookSession>
Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
Dim oFld As Outlook.MAPIFolder
Set oFld = Application.Session.GetDefaultFolder(olFolderInbox)
If Not oFld Is Nothing Then
Set Items = oFld.Items
End If
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
modExport.SaveMailAsFile Item, olRTF
End If
End Sub

Public Sub SaveMailAsFile(oMail As Outlook.MailItem)
Dim dtDate As Date
Dim sPath As String: sPath = "U:\Auxiliaries\"
Dim sName As String
Dim sFile As String

sName = oMail.Subject
ReplaceCharsForFileName sName, "_"
dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbMonday, vbFirstJan1) _
& Format(dtDate, "-hhnnss", vbMonday, vbFirstJan1) _
& "-" & sName & ".html"
oMail.SaveAs sPath & sName, olHTML
End Sub

' Ersetzt in Dateinamen unerlaubte Zeichen
Public Sub ReplaceCharsForFileName(ByRef sName As String, sChr As
String)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub
</ThisOutlookSession>

 

[Lester]

Thank you, Michael. 2 problems:

1. I put the code in ThisOutlookSession, and now, when I receive an
e-mail I get the error '424', 'Object required'.
Execution halts at

modExport.SaveMailAsFile Item, olRTF

2. The code seems to run on all e-mails (?). I only want to save
e-mails with "Today's numbers" in the subject.

Again, thanks, I really appreciate your efforts.

Lester

 

[Michael Bauer]

modExport.SaveMailAsFile Item, olRTF

Sorry, it should be:

SaveMailAsFile Item

 

[Michael Bauer]

modExport.SaveMailAsFile Item, olRTF

Sorry, it should be:

SaveMailAsFile Item

 

[Michael Bauer]

1. Should be solved.
2. You could add a few lines in the SaveMailAsFile sub after the line:

Public Sub SaveMailAsFile(oMail As Outlook.MailItem)
[....]
sName = oMail.Subject

If Instr(1, sName, "Today's numbers", vbTextCompare) Then
[... here the rest of the former sample]
EndIf
End Sub

 

[Lester]

Thanks, that works just perfect!

1. Should be solved.
2. You could add a few lines in the SaveMailAsFile sub after the line:

Public Sub SaveMailAsFile(oMail As Outlook.MailItem)
[....]
sName = oMail.Subject

If Instr(1, sName, "Today's numbers", vbTextCompare) Then
[... here the rest of the former sample]
EndIf
End Sub

 

[Cooper Chen]

Hi Sir, it's a nice code, but I had a question, if this mail include
attach file(s), do you have any idea?

 

[Michael Bauer]

Hi Cooper,

yes, I have. Please, loop through the MailItem.Attachments collection
and save each Attachment separatly to your disk.

 

[Lester]

It seems I have a problem with code after all.
It works perfectly well, when I test it by forwarding an e-mail to
myself. But not in 'real life'.
The relevant e-mail comes in at late night, so I am not sure what
happens.
I see two possible causes:

1. It somehow does not work, when multiple e-mails are retrieved at
once?

2. It is ignored, when Rules move the e-mail from the inbox to a
different folder?

Any ideas?

Thanks, that works just perfect!

1. Should be solved.
2. You could add a few lines in the SaveMailAsFile sub after the line:

sName = oMail.Subject

Public Sub SaveMailAsFile(oMail As Outlook.MailItem)
[....]
sName = oMail.Subject

If Instr(1, sName, "Today's numbers", vbTextCompare) Then
[... here the rest of the former sample]
EndIf
End Sub

 

[Lester]

Sorry, post was supposed to go here.

It seems I have a problem with code after all.
It works perfectly well, when I test it by forwarding an e-mail to
myself. But not in 'real life'.
The relevant e-mail comes in at late night, so I am not sure what
happens.
I see two possible causes:

1. It somehow does not work, when multiple e-mails are retrieved at
once?

2. It is ignored, when Rules move the e-mail from the inbox to a
different folder?

 

[Michael Bauer]

Hi Lester,

ad 1) AFAIK if more than 16 mails are retrieved at once it doesn´t work.
ad 2) That´s correct, too. In this line:

Set oFld = Application.Session.GetDefaultFolder(olFolderInbox)

you´re setting a reference on the Inbox. If the mail is moved into
another folder you´d better set the reference to that one.

 

[Lester]

Oh boy, this is embarrasing, but I am going VBA-KOLD.

Could you please tell me how to set that folder. It seems that
whatever I try, it works on folders on the HDD.

 

[Michael Bauer]

Hi Lester,

1) You can use Sue´s function, it returns a MapiFolder by it´s path:

http://www.outlookcode.com/d/code/getfolder.htm

2) It´s a simple object hierarchy, each folder has a Folders collection.
The root folders are available via Application.Session.Folders. So you
can walk through this hierarchy using the
a) index: Set oFolder=AnyMapiFolder.Folders(i), or
b) name: Set oFolder=AnyMapiFolder.Folders("x"), or
c) mixed: Set oFolder=AnyMapiFolder.Folders(i).Folders("x")