OutLook中编写插件,实现发送邮件到Joplin

  • A+
所属分类:其他

1.Outlook中找到宏编辑器,如果找不到入口,可以通过Alt+F11快捷键进入,

5c10b66ecd304166bf00f659e7486c6b.png

双击左侧ThisOutlookSession,添加以下代码,
````
Private Sub SendToJoplin(sToken As String, sNoteId As String)
Dim sURL, sEscapedBody, sJSONString As String
sURL = "http://127.0.0.1:41184/notes?token=" & sToken
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", sURL, False
.Send
Do Until .ReadyState = 4: DoEvents: Loop
sJSONString = .ResponseText
End With
Debug.Print sJSONString
Dim objItem As Outlook.MailItem
For Each objItem In ActiveExplorer.Selection
sEscapedBody = EscapeBody(objItem.HTMLBody)
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", sURL, False
.Send "{ ""title"": """ & objItem.ConversationTopic & """" _
& ", ""parent_id"": """ & sNoteId & """" _
& ", ""body_html"": """ & sEscapedBody & """" _
& " }"
'Do Until .ReadyState = 4: DoEvents: Loop
'sJSONString = .ResponseText
End With
Next
MsgBox "发送成功"
'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

Public Sub EmailToJoplin()
Dim sToken As String
Dim sURL, sJSONString, noteID, noteTitle, defaultNoteTitle As String
defaultNoteTitle = "邮件"
sToken = "129cd9832b880392847ec6449e604e685705999a5ef73c4314d31c328848568d50541ba660c7c3b608186ae6a154999ab183bf66748bb03bd750d28e5c2ca431"
sURL = "http://127.0.0.1:41184/folders?token=" & sToken
On Error GoTo MyErr
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", sURL, False
.Send
Do Until .ReadyState = 4: DoEvents: Loop
sJSONString = .ResponseText
End With
'Debug.Print sJSONString
Set x = CreateObject("ScriptControl"): x.Language = "JScript"
x.AddCode ("var json=" & sJSONString & ";")
Dim cnt As Integer
cnt = x.eval("json.length")
Dim myd As Object
Set myd = CreateObject("Scripting.Dictionary")
Dim fm As New UserForm1
For i = 0 To cnt - 1
noteID = x.eval("json[" & i & "].id")
noteTitle = x.eval("json[" & i & "].title")
fm.ComboBox1.AddItem (noteTitle)
myd(noteTitle) = noteID
Next
If myd.Exists(defaultNoteTitle) Then
fm.ComboBox1.Text = defaultNoteTitle
End If
fm.Show
'Debug.Print fm.noteTitle
If fm.noteTitle <> "" Then
'Debug.Print myd.Item(fm.noteTitle)
SendToJoplin sToken, myd.Item(fm.noteTitle)
End If
Unload fm
Exit Sub
MyErr:
msg = " 错误 " & Err.Number & " : " & Err.Description
MsgBox msg
End Sub
````
注意:EmailToJoplin代码中sToken需替换为自己Joplin中的Token。经测试,如果Joplin是在本地,sToken即便错误也可正常使用。defaultNoteTitle可以改为默认发送到的笔记本名称

2.在宏编辑器中添加如下窗口,窗口命名为UserForm1,添加列表框ComBox1和按钮button1和button2

70f43c4ddf04195dc57e3b50b3ffd81f.png

3.在UserForm1窗口中加入如下代码,

````
Public noteTitle As String
Private Sub CommandButton1_Click()
noteTitle = Me.ComboBox1.Text
Me.Hide
End Sub

Private Sub CommandButton2_Click()
Me.Hide
End Sub
````

4.在Outlook快速访问工具栏中添加按钮,指向EmailToJoplin函数,方便快速调用宏

通过文件/选项,打开outlook选项窗口,

59051ecbea129811a2c61278485eb8cc.png

点击快速访问工具栏,打开如下窗口,选择命令下拉框切换至,将左侧列表框中的EmailToJoplin添加至右侧列表框,可自定义图标和名称。

ae5da4765ee6b8b03675a04ba76581dd.png

点击确定后,在outlook快速工具栏出现对应的EmailToJoplin宏按钮

10d4d9a58c56d354f1f200099ea8f80f.png

5.选择单封邮件,点击EmailToJoplin宏按钮,弹出如下窗口,选择需要将邮件发送至哪个笔记本中,点击确定按钮,如果放成功,会弹出"发送成功"提示,如果出错,会弹出错误提示。

256f487e4807ef761d4ef689b03faa05.png
点击

  • 我的微信
  • 这是我的微信扫一扫
  • weinxin
  • 我的微信公众号
  • 我的微信公众号扫一扫
  • weinxin