This Excel VBA macro can import and export Evernote files (*.enex). OutputNotesXML() macro (taken from https://gist.github.com/robertpateii/2992931) is able to save an Excel workbook into the file evernote-import.enex, that can be imported to Evernote later on. ReadNotesXML() macro (my contribution) is able to read *.enex files exported from Eve…

Evernote_Import_Export_Macro.vba

Option Explicit

Sub OutputNotesXML()

Dim iRow As Long

Close #1
With ActiveSheet
    'For iRow = 2 To 2
    Open ThisWorkbook.Path & "\evernote-import.enex" For Output As #1
        Print #1, "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "UTF-8" & Chr(34) & "?>"
        Print #1, "<!DOCTYPE en-export SYSTEM " & Chr(34) & "http://xml.evernote.com/pub/evernote-export.dtd" & Chr(34) & ">"
        Print #1, "<en-export export-date=" & Chr(34) & "20120202T073208Z" & Chr(34) & " application=" & Chr(34) & "Evernote/Windows" & Chr(34) & " version=" & Chr(34) & "4.x" & Chr(34) & ">"
    For iRow = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
        Print #1, "<note><title>"
        Print #1, .Cells(iRow, "A").Value 'Title
        Print #1, "</title><content><![CDATA[<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "UTF-8" & Chr(34) & "?>"
        Print #1, "<!DOCTYPE en-note SYSTEM " & Chr(34) & "http://xml.evernote.com/pub/enml2.dtd" & Chr(34) & ">"
        Print #1, "<en-note style=" & Chr(34) & "word-wrap: break-word; -webkit-nbsp-mode: space; -webkit-line-break: after-white-space;" & Chr(34) & ">"
        Print #1, CBr(.Cells(iRow, "B").Value) 'Note
        Print #1, "</en-note>]]></content><created>"
        Print #1, .Cells(iRow, "D").Text 'Created Date in Evernote Time Format...
        'To get the evernote time, first convert your time to Zulu/UTC time.
        'Put this formula in Column D: =C2+TIME(6,0,0) where 6 is the hours UTC is ahead of you.
        'Then right click on your date column, select format, then select custom. Use this custom code: yyyymmddThhmmssZ
        Print #1, "</created><updated>201206025T000001Z</updated></note>"
    Next iRow
    Print #1, "</en-export>"
    Close #1
    
End With

End Sub

Function CBr(val) As String
    'parse hard breaks into to HTML breaks
    CBr = Replace(val, Chr(13), "")
    CBr = Replace(CBr, "&", "&amp;")
End Function

'I modified this code from Marty Zigman's post here: http://blog.prolecto.com/2012/01/31/importing-excel-data-into-evernote-without-a-premium-account/

' This will read ENEX file (Evernote export file) into Excel worksheet
Sub ReadNotesXML()
    Dim fdgOpen As FileDialog
    Dim fp As Integer
    Dim i As Integer
    Dim DataLine As String, WholeFileContent As String
    Dim RE As Object, allMatches As Object
    Set RE = CreateObject("vbscript.regexp")
    
    Set fdgOpen = Application.FileDialog(msoFileDialogOpen)
    With fdgOpen
        .Filters.Add "Evernote files", "*.enex", 1
        .TITLE = "Please open Evernote file..."
        .InitialFileName = "."
        .InitialView = msoFileDialogViewDetails
        .Show
    End With
    ' MsgBox fdgOpen.SelectedItems(1)
    fp = FreeFile()
    WholeFileContent = ""
    Open fdgOpen.SelectedItems(1) For Input As #fp
        WholeFileContent = Input$(LOF(fp), fp)
    Close #fp
    ' Removing CR&LF line endings
    WholeFileContent = Replace(WholeFileContent, Chr(10), "")
    WholeFileContent = Replace(WholeFileContent, Chr(13), "")
    ' Worksheets(1).Cells(5, 5) = WholeFileContent
    ' First line
    Worksheets(1).Cells(1, 1) = "Title"
    Worksheets(1).Cells(1, 2) = "Content"
    Worksheets(1).Cells(1, 3) = "Created"
    Worksheets(1).Cells(1, 4) = "Updated"
    ' Filter for title
    RE.Pattern = "<title>(.*?)<\/title>"
    RE.IgnoreCase = True
    RE.Global = True
    RE.MultiLine = True
    Set allMatches = RE.Execute(WholeFileContent)
    For i = 0 To allMatches.Count - 1
        Worksheets(1).Cells(2 + i, 1) = allMatches(i).submatches(0)
    Next
    ' Filter for content
    RE.Pattern = "<content>(.*?)<\/content>"
    'RE.IgnoreCase = True
    'RE.Global = True
    Set allMatches = RE.Execute(WholeFileContent)
    For i = 0 To allMatches.Count - 1
        Worksheets(1).Cells(2 + i, 2) = StripTags(allMatches(i).submatches(0))
    Next
    ' Filter for created
    RE.Pattern = "<created>(.*?)<\/created>"
    'RE.IgnoreCase = True
    'RE.Global = True
    Set allMatches = RE.Execute(WholeFileContent)
    For i = 0 To allMatches.Count - 1
        Worksheets(1).Cells(2 + i, 3) = allMatches(i).submatches(0)
    Next
    ' Filter for updated
    RE.Pattern = "<updated>(.*?)<\/updated>"
    'RE.IgnoreCase = True
    'RE.Global = True
    Set allMatches = RE.Execute(WholeFileContent)
    For i = 0 To allMatches.Count - 1
        Worksheets(1).Cells(2 + i, 4) = allMatches(i).submatches(0)
    Next
    ' Free
    Set RE = Nothing
    Set allMatches = Nothing
End Sub

Function StripTags(inString As String) As String
    Dim RE As Object, allMatches As Object
    Set RE = CreateObject("vbscript.regexp")
    ' Keeping enters
    inString = Replace(inString, "</div>", " ")
    ' Removing   other <tag>-s
    RE.Pattern = "<[^>]+>"
    RE.IgnoreCase = True
    RE.Global = True
    StripTags = RE.Replace(inString, "")
    ' Cleaning up strange things
    StripTags = Replace(StripTags, "]]>", "")
    StripTags = Replace(StripTags, "&apos;", "'")
    StripTags = Replace(StripTags, "&nbsp;", "  ")
    ' Free
    Set RE = Nothing
    Set allMatches = Nothing
End Function

Sub r2i()
    Dim lLastRow As Long
    Dim lLastCol As Long
    Dim rgLast As Range
    Dim rgSrc As Range
    Dim rgDst As Range
    Dim i, j As Integer
    Dim RE As Object, allMatches As Object
    Set RE = CreateObject("vbscript.regexp")
    Dim m As String
    
    Set rgLast = Range("A1").SpecialCells(xlCellTypeLastCell)
    lLastRow = rgLast.Row
    lLastCol = rgLast.Column
    
    Set rgSrc = Range(Cells(2, 2), Cells(lLastRow, 2))
    Set rgDst = Range(Cells(2, 1), Cells(lLastRow, 1))
    RE.Pattern = "\((.*?)\)"
    RE.IgnoreCase = True
    RE.Global = True
    
    For i = 1 To rgSrc.Count
        ' Getting stuff in brackets
        Set allMatches = RE.Execute(rgSrc.Cells(i, 1))
        m = ""
        If allMatches.Count > 0 Then
            For j = 0 To allMatches.Count - 1
                If allMatches.Count = 1 Then
                  m = allMatches(j).submatches(0)
                Else
                  m = m & allMatches(j).submatches(0) & ";"
                End If
            Next
            rgDst.Cells(i, 1) = m
        Else
            m = rgDst.Cells(i, 1)
            rgDst.Cells(i, 1) = rgSrc.Cells(i, 1)
            rgSrc.Cells(i, 1) = m
        End If
    Next
    Set RE = Nothing
    Set allMatches = Nothing
End Sub

Sub i2r()
    Dim lLastRow As Long
    Dim lLastCol As Long
    Dim rgLast As Range
    Dim rgSrc As Range
    Dim rgDst As Range
    Dim i As Integer
    Dim RE As Object, allMatches As Object
    Set RE = CreateObject("vbscript.regexp")
    Dim m As String
    
    Set rgLast = Range("A1").SpecialCells(xlCellTypeLastCell)
    lLastRow = rgLast.Row
    lLastCol = rgLast.Column
    
    Set rgSrc = Range(Cells(2, 2), Cells(lLastRow, 2))
    Set rgDst = Range(Cells(2, 1), Cells(lLastRow, 1))
    RE.Pattern = "^(.*?)\s+\(.*"
    RE.IgnoreCase = True
    RE.Global = True
    
    For i = 1 To rgSrc.Count
        ' Getting stuff in brackets
        Set allMatches = RE.Execute(rgSrc.Cells(i, 1))
        If allMatches.Count > 0 Then
            rgDst.Cells(i, 1) = allMatches(0).submatches(0)
        Else
            m = rgDst.Cells(i, 1)
            rgDst.Cells(i, 1) = rgSrc.Cells(i, 1)
            rgSrc.Cells(i, 1) = m
        End If
    Next
    Set RE = Nothing
    Set allMatches = Nothing
End Sub

I'd be interested in retaining a list of tags, such as a single cell with delimited entries, or as multiple cells. Would simply removing the "StripTags" function achieve this? What is the purpose of stripping out the tags?

To pull the tags out, try adding these lines between lines 107 and 108 above. I'm no coder, so it's probably a bit hacky but it seems to work OK: Might be a bit slow if you have a lot of notes - it parses the whole thing.

' Filter for tags

Dim j As Integer
Dim FoundTagStart As Integer
Dim NewTagSameNote As Integer
Dim WholeFileLength As Integer
Dim StringPosn As Integer
Dim Tag As String

i = 0
j = 0
StringPosn = 0
WholeFileLength = Len(WholeFileContent)

IncrStringPosn:
StringPosn = StringPosn + 1
    If StringPosn > WholeFileLength Then
        GoTo EndTagSearch
    End If
    If NewTagSameNote = 0 Then
        j = 0
    End If
    If (Mid(WholeFileContent, StringPosn, 5) = "<tag>") Then
        FoundTagStart = 1
        StringPosn = StringPosn + 4
        GoTo IncrStringPosn
    End If
    If (FoundTagStart = 1) And (Mid(WholeFileContent, StringPosn, 6) <> "</tag>") Then
        Tag = Tag + Mid(WholeFileContent, StringPosn, 1)
        GoTo IncrStringPosn
    End If
    If (FoundTagStart = 1) And (Mid(WholeFileContent, StringPosn, 11) = "</tag><tag>") Then
        NewTagSameNote = 1
        Worksheets(1).Cells(2 + i, 5 + j) = StripTags(Tag)
        Tag = ""
        j = j + 1
        StringPosn = StringPosn + 10
        GoTo IncrStringPosn
    End If
    If (FoundTagStart = 1) And (Mid(WholeFileContent, StringPosn, 6) = "</tag>") Then
        NewTagSameNote = 0
        Worksheets(1).Cells(2 + i, 5 + j) = StripTags(Tag)
        Tag = ""
        i = i + 1
        FoundTagStart = 0
        GoTo IncrStringPosn
    End If
    GoTo IncrStringPosn
EndTagSearch:

p.s. the 'StripTags' function accounts for some of the markup used in the .enex file rather than 'Tags' in the Evernote sense of the word :)

OK, found a problem - doesn't work if there are pictures in the Evernotes :( It trips on the 'len' statement - not sure of I've reached an absolute limit of if I can declare may variable differently to get round it...?

Hey great code, I have used the code which pulls information from Evernote into Excel which works a treat, but I'd like it to also pull the location and author in from Evernote too. How can I get it to do this?