Outlook 2010: Solved: Exporting Mails inclusive MSG-Attachment via VBA

[Olli 11]

Hi Folks,

 

i did some VBA-Coding (thanks to the little Tool called "Internet" and a lot of posts from real cracks! :-)). Hopefully I did not forget to credit some of the girls/guys!

 

The Problem was: whenever i transferred an E-Mail from Outlook (2010) to Evernote, there was no way back... no way to answer or forward the Mail from Outlook again. :-(

I missed the function to doubleclick on the E-Mail in Evernote and get all the Outlookfunctions back i need for proper work with E-Mails.

So I looked for a solution, that would save the E-Mail in MSG-Format and attach this to my Evernote-Note.

After a while I decided to code one myself.

 

The following Code runs very well on my PC (Outlook 2010, Win 7). It uses ENScript.exe, which comes with every Evernote-Installation.

 

Configuration:

- After importing the Code you MUST adapt a few Parameters (see section "Begin Configuration" in the Code)

(It's not difficult to do...)

These are the configuration options:

'1. Configuration: Temporary Directory (The Makro saves your Mails in this Direktory before importing them to Evernote)
'2. Configuration - Path to your ENScript.exe (for example: "c:\Program Files (x86)\Evernote\Evernote\ENScript.exe")
'3. Configuration: Notebook (The Mails will be saved in this Notebook)
'4. Configuration: Tag (optional) (only one Tag possible; for example: "Outlookmail")
'5. Configuration: Categorie (marks the exported Mails)

 

I added a sixth configuration possibility at the end of the Script:
'6. Configuration: Sender of the E-Mail
'You will get better Note-Titles, if you adapt the E-Mail-Adress of the Sender to your needs!
'See Section "Private Function Sendertranslate" below with an Example, how to do this.

 

USAGE after "installation" of the Script in Outlook

- Mark one or more Mails in your Inbox

- Run the makro

- Two files will be created for every E-Mail: A Textfile with the E-Mail-Content and a File in Outlook-MSG-Format

- Evernote creates from these two files a new Note with the Text of the Mail (simple Text for Searching issues) AND the E-Mail as MSG attached.

- A simple Doubleclick from Evernote on the Attachment opens the Mail in Outlook.

 

Tested with: Outlook 2010, Win 7

 

I hope, this is helpful for you as well,

 

have a nice day,

 

Olli

 

This Evernote-Note contains all you need:

http://www.evernote.com/shard/s126/sh/04216e0c-7032-43dd-a4ff-6694772736a3/37e09c4d80ac37ae9d52d3a074865cb3

 

OR, if the link fails to work:

 

'Copy everything below this line into a new Module in Outlook - don't forget to configure it in the Section "Begin Configuration"

 

 

Sub EN_MailAblage_v2()
'----------------------------------------------------------------------------
'Saves E-Mail from Outlook to Evernote
'
'Read this... :-)
'----------------------------------------------------------------------------
'I) How it works:
'----------------
'This Routine creates a new Note in several steps:
'Step 1:
'Export the content of the E-Mail as Text on your Drive
'Step 2:
'Export the Email as Outlook-Mail (MSG-Format) on your Drive
'Step 3:
'Create a new Note with the Text-Part
'Step 4:
'Attach the MSG-Format to the Note
'
'II) Result:
'-----------
'You'll get one Note for every E-Mail
'
'III) Advantage:
'---------------
'The Textpart allows you to search the whole content of the E-Mail in Evernote
'The MSG-Format (Outlook) means, that a Double-Click on the Attachment from Evernote will open the complete E-Mail in Outlook-Format;
'So you have again access to all E-Mail-functions
'
'IV) Usage:
'----------
'Select one or more E-Mails from your E-Mail-Inbox an run this Makro
'
'V) Konfiguration
'----------------
'Very important! First you MUST configure the Makro in the Section "Begin Configuration" below!
'
'VI) Credits:
'------------
'I have used lots of sources from the internet and added the Evernotefunctions
'Here are the main sources:
'http://www.chf-online.de/ol/olvbamailspeichern.htm
'http://www.office-loesung.de/ftopic207510_0_0_asc.php
'vbarchiv.net / Dieter Otter
'
'-------------------------------------------------------------------------------
'Use at your own risk!
'created 2013/11/27, Version 2
'O. Unkelbach
'oliver (at) unkelbach (dot) com
'-------------------------------------------------------------------------------

Dim strAblagepfad As String
Dim strENscriptExe As String
Dim strNotebook As String
Dim strTag As String
Dim strCategorie As String



'#############################################################################
'-----------------------------------------------------------------------------
'Begin Configuration - IMPORTANT!
'Adapt these to avoid failures
'-----------------------------------------------------------------------------
'1. Configuration: Temporary Directory
'The Makro saves your Mails in this Direktory before importing them to Evernote!
'The directory must exist - it will not be created.
'This Makro does not delete the Mails from this directory after exporting them to Evernote.
strAblagepfad = "t:\Evernotemails\"


'2. Configuration - Path to your ENScript.exe
strENscriptExe = "c:\Program Files (x86)\Evernote\Evernote\ENScript.exe"


'3. Configuration: Notebook (The Mails will be saved in this Notebook)
strNotebook = "_Eingang"


'4. Configuration: Tag (optional) (only one Tag possible)
'strTag = "" means: no Tag is set.

'strTag = ""
strTag = "_Outlook"


'5. Configuration: Categorie
'Option 5 marks the exported Mails (optional)
'strCategorie = "" means: no Categorie

'strCategorie = ""
strCategorie = "EN o.k."


'6. Configuration: Sender of the E-Mail
'You will get better Note-Titles, if you adapt the E-Mail-Adress of the Sender to your needs!
'See Section "Private Function Sendertranslate" below with an Example, how to do this.

'-----------------------------------------------------------------------------
'End Configuration
'-----------------------------------------------------------------------------
'#############################################################################



Dim c As Integer



Dim mailExplorer As Outlook.Explorer
Dim mailFolder As Outlook.MAPIFolder
Dim strDateinameTXT As String
Dim strDateinameMSG As String
Dim strSender As String
Dim mailItem As mailItem
Dim strMailText As String
Dim olSelection As Selection
Dim datDatum As Date
Dim strDatum As String


Dim lngAttCount As Long, i As Long

Set mailExplorer = Application.ActiveExplorer
Set mailFolder = mailExplorer.CurrentFolder

Dim strEvernotenotiz As String


'If the Makro got started from the wrong directory -> Exit
If Not mailFolder.DefaultItemType = olMailItem Then
    Exit Sub
End If


'Exists Path?
If Dir(strAblagepfad, vbDirectory) <> "" Then
Else
    MsgBox strAblagepfad & " not found!" + vbCrLf + "E-Mail not exported to Evernote.", vbCritical, "Evernote-Export failed!"
    Exit Sub
End If

'Save E-Mails into Selection-Object
Set olSelection = mailExplorer.Selection

'Exportroutine for the selected E-Mails
For Each mailItem In olSelection
    c = c + 1
   
    'if the Sender-Adress seems to be problematic, enable the following line for further informations
    'Debug.Print "Before translation: " & mailItem.SenderEmailAddress

    strSender = Sendertranslate(mailItem.SenderEmailAddress)
    strMailText = mailItem.Body
   
    'Sender-Adress after translation:
    'Debug.Print "After translation: " & strSender
   
    itemName = Format(mailItem.ReceivedTime, "yyyymmdd") & "_" & strSender & "_" & mailItem.Subject
   
    'Dateiname .txt
    strDateinameTXT = IIf(Len(strAblagepfad & itemName) > 255, _
    Left(itemName, 255 - Len(strAblagepfad)), itemName) & ".txt"
   
    'Dateiname .msg
    strDateinameMSG = IIf(Len(strAblagepfad & itemName) > 255, _
    Left(itemName, 255 - Len(strAblagepfad)), itemName) & ".msg"
   
    'Create Textfile to avoid Evernote-Problems due to import issues
    strMailText = CleanString(strDateinameTXT) + vbCrLf + vbCrLf + strMailText
   
    'Add Slash (\) to Pathname if not set
    If Right(strAblagepfad, 1) <> "\" Then
        strAblagepfad = strAblagepfad & "\"
    End If
   
   
    'Save-Routine
    'a) Save as .msg (Outlook-Format for Attachment issues)
    mailItem.SaveAs strAblagepfad & CleanString(strDateinameMSG), olMSG
     
    'b) Save as .txt
    SchreibeTextDatei strAblagepfad & CleanString(strDateinameTXT), strMailText

    datDatum = mailItem.ReceivedTime
    strDatum = Format(datDatum, "YYYY/MM/DD hh:mm:ss")
    strDatum = ReplaceChar(strDatum, ".", "/")

    'Create Evernote-Note
    Call Evernotenotiz(strENscriptExe, strNotebook, strDateinameTXT, strAblagepfad & strDateinameTXT, strAblagepfad & strDateinameMSG, strTag, strDatum)
   

    'Set a Categorie, if configured above
    If strCategorie <> "" Then
        mailItem.Categories = strCategorie
        mailItem.Save
    End If
   
   
    'Actually not implemented - Don't use!:
    'This routine should delete the temporary files, but sometimes is Evernote to slow
    '(that means: the files were deleted bevore Evernote has imported them)
    'For this reason I deactivated the following lines:
    'KillProperly strAblagepfad & strDateinameMSG
    'KillProperly strAblagepfad & strDateinameTXT
   

Next

    If c = 1 Then
        MsgBox "E-Mail saved into Notebook [" & strNotebook & "]."
    Else

        'correct Line: MsgBox Str( c ) etc. and delete spaces around c (instead of Copyright-Mark - wrongly inserted by the Forum-Software - see remark below)
        MsgBox Str© & " E-Mails saved into Notebook [" & strNotebook & "]."
    End If

End Sub

Private Function CleanString(strData As String) As String
'cleans Filenames; immportant for Evernoteimport, too
    strData = ReplaceChar(strData, "´", "_")
    strData = ReplaceChar(strData, "`", "_")
    strData = ReplaceChar(strData, "'", "_")
    strData = ReplaceChar(strData, "{", "(")
    strData = ReplaceChar(strData, "[", "(")
    strData = ReplaceChar(strData, ]", ")")
    strData = ReplaceChar(strData, "}", ")")
    strData = ReplaceChar(strData, "/", "-")
    strData = ReplaceChar(strData, "\", "-")
    strData = ReplaceChar(strData, ":", "")
    strData = ReplaceChar(strData, ";", "")
    strData = ReplaceChar(strData, "*", "_")
    strData = ReplaceChar(strData, "?", "")
    strData = ReplaceChar(strData, """", "_")
    strData = ReplaceChar(strData, "|", "")
    strData = ReplaceChar(strData, " ", "_")
    strData = ReplaceChar(strData, "@", "_")
    strData = ReplaceChar(strData, "-", "_")
    strData = ReplaceChar(strData, "(", "")
    strData = ReplaceChar(strData, ")", "")
    strData = ReplaceChar(strData, "&", "u")
    strData = ReplaceChar(strData, ",", "")
    CleanString = Trim(strData)
End Function


Private Function ReplaceChar(strData As String, strBadChar As String, strGoodChar As String) As String
'replace Chars
    Dim tmpChar, tmpString As String
    Dim i As Long
   
    For i = 1 To Len(strData)
        tmpChar = Mid(strData, i, 1)
        If tmpChar = strBadChar Then
            tmpString = tmpString & strGoodChar
        Else
            tmpString = tmpString & tmpChar
        End If
    Next i
   
    ReplaceChar = Trim(tmpString)
End Function



Private Function SchreibeTextDatei(ByVal sFilename As String, ByVal sLines As String)
'writes a Textstring into a File
'The current Content get's deleted!
'Code from: vbarchiv.net / Dieter Otter
 
  Dim F As Integer

  F = FreeFile
  Open sFilename For Output As #F
  Print #F, sLines
  Close #F
End Function


Public Sub KillProperly(Killfile As String)
'Delete a File from Directory
'aktually not used!
'Code from: http://word.mvps.org/faqs/macrosvba/DeleteFiles.htm
    If Len(Dir$(Killfile)) > 0 Then
        SetAttr Killfile, vbNormal
        Kill Killfile
    End If
End Sub

Public Sub Evernotetest()
'Just an example for saving a note into Evernote using ENScript.exe
'------------------------------------------------------------------------------
'uses:
'This Sub: Evernotetest
'Sub Evernotenotiz
'Function: ReplaceChar
'-------------------------------------------------------------------------------
'Use at your own risk!
'created 2013/11/27, Version 2
'O. Unkelbach
'oliver (at) unkelbach (dot) com
'-------------------------------------------------------------------------------

Dim strENscriptExe As String 'Path to ENScript.exe
Dim strNotetitel As String   'Title of your Note
Dim strFilename As String    'Textfile containing the Content of the note
Dim strNotebook As String    'Notebook to save into
Dim strAttachment As String  'An attachment
Dim strTag As String         'Tag, for example "Outlook"
Dim datDatum As Date         'Date of the Note
Dim strDatum As String       'used to convert the Date into the Format that Evernote expects

strENscriptExe = "c:\Program Files (x86)\Evernote\Evernote\ENScript.exe"
strNotebook = "_Eingang"
strNotetitel = "TESTxyz"
strFilename = "T:\test.txt"
strAttachment = "t:\test.pdf"
datDatum = Now()

'convert Date to Evernotedate
strDatum = Format(datDatum, "YYYY/MM/DD hh:mm:ss")
strDatum = ReplaceChar(strDatum, ".", "/")

Call Evernotenotiz(strENscriptExe, strNotebook, strNotetitel, strFilename, strAttachment, strTag, strDatum)

End Sub


Public Sub Evernotenotiz(strENscriptExe As String, strNotebook As String, strNotetitel As String, strFilename As String, strAttachment As String, strTag As String, strDatum As String)
'creates a note in Evernote using ENScript.exe

If strTag = "" Then
'Evernote Note without TAG
    Call Shell(strENscriptExe & " createnote" & _
    " /i """ & strNotetitel & """ /n """ & strNotebook & """ /s """ & strFilename & """ /a """ & strAttachment & """ /c """ & strDatum & """", 1)
Else
'Evernote Note with Tag
    Call Shell(strENscriptExe & " createnote" & _
    " /i """ & strNotetitel & """ /n """ & strNotebook & """ /s """ & strFilename & """ /a """ & strAttachment & """ /c """ & strDatum & """ /t """ & strTag & """", 1)
End If

End Sub

Private Function Sendertranslate(strSender As String)
'Translates an E-Mail-Adress in a tangible Name

'Sometimes Outlook returns strange E-Mail-Sender-Informations, for example
' "/O=SERVERNAME/OU=SECOND ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=MAUS_MICKY"
'With this routine it is possible to translate this to your needs.

'USAGE:
'Put your E-Mail-Adresses in here to translate them into tangible Names for the Note's title
'Don't use comma, semicolon etc. Just A-Z, a-z, 0-9 and underscore _
'See Example below!

Dim tmpString As String
tmpString = strSender

Select Case strSender
'3 Examples:
'   Case "johndoe@jdhasandomain.com"
'       tmpString = "Doe_John"
'   Case "micky-maus@disneywasgreat.com"
'       tmpString = "Maus_Micky"
'   Case "/O=SERVERNAME/OU=SECOND ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=GOOFY"
'       tmpString = "Goofy"

    Case Else
        tmpString = strSender
End Select

Sendertranslate = Trim(tmpString)
End Function

[Olli 11]

By importing the script the forumsoftware has produced a small error:

 

If c = 1 Then
        MsgBox "E-Mail saved into Notebook [" & strNotebook & "]."
    Else
        HERE IS THE MISTAKE: ------> MsgBox Str© & " E-Mails saved into Notebook [" & strNotebook & "]."
    End If

 

Instead of Copyright type Open round bracket c close round bracket:

MsgBox Str(  c  ) & " E-Mails saved into Notebook [" & strNotebook & "]."

 

(Delete space around "c")

 

Olli

[hubutz 2]

Hi Olli,

 

this is quite nice! I have just some issues with the Sendernames the naming of the txt/mail-files.

The files look like "20131213__O=MAIL_OU=DE_CN=RECIPIENTS_CN=BACHMANNBE_WG_Einstellung_zum_01._Oktober_2013.txt" at my side. Any Idea how I can get a Sendername out of that? Sorry - if my english is not that good...

 

Cheers,

Ben

[Olli 11]

Hi, Ben!

My English isn't that Good, either : D

For your problem you'll find a simple Solution:

look at the function "Sendertranstate,,

There are examples to exchange those weird

E-Mail Adresses.

Kind regards

0lIi

[hubutz 2]

Hi Olli,

 

thanks a lot - but this section doesn't help me a lot. It just seems not to be working.

I've entered there: "/O=MAIL/OU=DE_CN/RECIPIENTS_CN=BACHMANNBE" but I'm not sure if that's the correct string. If I press answer or forward Outlook is just showing the correct senders information.:/

[hubutz 2]

Allright, the right code is:

Case "/O=MAIL/OU=DE/CN=RECIPIENTS/CN=KUBISO"

        tmpString = "KUBISO"

 

the next issue is that I've like to save mails from different senders having all the same kind of scheme (like the above), but the above one is a static one. I'd like to have it with a variable (at the point where KUBISO stands). Any chance to get this working?

[Olli 11]

Hi, Ben, i am writing from Fuerteventura, so my access to a working Outlook is very limited

However, there is a vba command called instr.

I don't know the exact Syntax, but

I suppose, this can be used for your Problem.

The right Section in the code is here:

old:

strSender = Sendertranslate(mailItem.SenderEmailAddress)

New -not tested, just for instruction:

It must be something like that:

If instr (mailitem.Senderemailadress) = "Kubiso" then

Strsender = "yoursender"

Else

Strsender = sendertranslate(mailitem.senderemailadress)

End if

I will be back in a week and can help you with the code, if you have trouble to sort it out by yourself,

Bye

Olli

[flatlanderdox 7]

Thanks for posting this! This is exactly something I've been looking for. I was just about to try to figure out how to do the VBA code on this and here it is already! Awesome! I am looking forward to implementing this.