Send email from Outlook to Joplin.bas

Public Sub SendToJoplin()
    Dim sToken As String, sURL As String
    Dim sURLNotes, sURLResources, sEscapedBody, sJSONString, sFolderID As String
    Dim objItem As Outlook.MailItem
    
    sToken = "REPLACE ME WITH YOUR TOKEN"
    sURL = "http://127.0.0.1:41184"
    sURLNotes = sURL & "/notes?token=" & sToken
    sURLResources = sURL & "/resources?token=" & sToken

    For Each objItem In ActiveExplorer.Selection
        sEscapedBody = EscapeBody( _
                "Date: " & objItem.ReceivedTime & "<br>" _
                & "To: " & objItem.To & "<br>" _
                & objItem.HTMLBody)
        
        sFolderID = GetFoldersFromJoplin(sToken, sURL)
                
        With CreateObject("MSXML2.XMLHTTP")
            .Open "POST", sURLNotes, False
            .Send "{ ""title"": """ & objItem.ConversationTopic & """" _
            & ", ""parent_id"": """ & sFolderID & """" _
            & ", ""body_html"": """ & sEscapedBody & """" _
            & " }"
            Do Until .ReadyState = 4: DoEvents: Loop
                sJSONString = .ResponseText
        End With
    Next
    'Debug.Print sJSONString 'Uncomment to see joplin response
End Sub

Private Function EscapeBody(sText As String)
    EscapeBody = sText
    EscapeBody = Replace(EscapeBody, "\", "\\")                 'Backslash is replaced with \\
    EscapeBody = Replace(EscapeBody, Chr(34), "\" & Chr(34))    'Double quote is replaced with \"
    EscapeBody = Replace(EscapeBody, vbCr, "\r")                'Carriage return is replaced with \r
    EscapeBody = Replace(EscapeBody, vbLf, "\n")                'Newline is replaced with \n
    EscapeBody = Replace(EscapeBody, Chr(8), "\b")              'Backspace is replaced with \b
    EscapeBody = Replace(EscapeBody, Chr(12), "\f")             'Form feed is replaced with \f
    EscapeBody = Replace(EscapeBody, vbTab, "\t")               'Tab is replaced with \t
End Function

Private Function GetFoldersFromJoplin(sToken As String, sURL As String)    
    'Input token, url
    'Output folder id
    
    Dim sJSONString, sMessage, sTitle, sDefault, sMyChoice As String
    Dim vJSON As Variant
    Dim sState As String
    Dim aData(), aHeader()
    Dim i As Integer

    sURL = sURL & "/folders?token=" & sToken
    
    'Get folders list
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", sURL, False
        .Send
        Do Until .ReadyState = 4: DoEvents: Loop
            sJSONString = .ResponseText
    End With
        
    'Parse JSON response
    JSON.Parse sJSONString, vJSON, sState
    JSON.ToArray vJSON, aData(), aHeader()
    
    'Dsiplay a choices of folders
    'Set prompt
    sMessage = "Enter a value between " & LBound(aData) & " To " & UBound(aData)
    For i = LBound(aData) To UBound(aData)
        sMessage = sMessage & Chr(10) & i & " " & aData(i, 2)
    Next i
    sTitle = "Choose Joplin folder..."    'Set title
    sDefault = "1"    'Set default
    sMyChoice = InputBox(sMessage, sTitle, sDefault)
    GetFoldersFromJoplin = aData(sMyChoice, 0)
End Function

Notes:

1. You need REPLACE ME WITH YOUR TOKEN,
2. For this code to work, you need to download and import this JSON.bas to your Outlook,
3. Make sure below References are enabled (Tools > References):
   

Thank you for the VBA code! Do you know if it is supposed to work with the latest version of Joplin. When I use it, I specify a folder (0 or 1 in my case) and nothing appears in Joplin. Thanks.

Hello @breisfeld, I had moved from Joplin to Obsidian.md hence I'm not sure if this script is still working.

Hello @ramisedhom, I understand. Thank you for the reply. :-)

In case anyone stumbles upon this. This can still work in Joplin 3.1.24 with a few adjustments.

1. In Joplin select the notebook you wish to be your target.
2. Right click on the notebook title and select Copy notebook ID.
3. Replace the line sFolderID = GetFoldersFromJoplin(sToken, sURL) above with "sFolderID =" and the notebook ID copied earlier.
4. Also be sure Joplin's webclipper service is enabled. (Tools-Options-Web Clipper- Enable Web Clipper Service)

Thanks