Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
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
@ramisedhom
Copy link
Author

ramisedhom commented Dec 30, 2019

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):
    image

@breisfeld
Copy link

breisfeld commented Apr 11, 2022

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.

@ramisedhom
Copy link
Author

ramisedhom commented Apr 11, 2022

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

@breisfeld
Copy link

breisfeld commented Apr 11, 2022

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

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment