Attribute VB_Name = "osTicketConnector"
Option Explicit
'===================================================================================================
' osTicketConnector
'
' This Outlook VBA Macro transform an Outlook mail item into an osTicket ticket using the provided
' osTicket API.
' It's designed to be a "one-click" macro to create support tickets from mail messages sent
' directly to the support staff
'
' For this to work you should have an up and running osTicket host, an API Key and an open http
' transport between the Outlook client and the osTicket host
'
'Copyright (C) 2013 Erich Strelow
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with this program. If not, see <http://www.gnu.org/licenses/>.'
'
' References:
' http://www.osticket.com
' https://github.com/osTicket/osTicket-1.7/blob/develop/setup/doc/api/tickets.md
'
' Changes:
' Apr 5 2013: Added additional processing for Exchange-type sender address
' Apr 9 2013: Added attachment support
'========================================================================================
'Change these to suit your environment
Const API_KEY = "CCF5EB1E75933B645087FBE1CAE62446"
Const HOST_NAME = "http://soporte.moller.cl"
Const MAX_ATTACHMENT = 2097152
Const PR_ATTACH_CONTENT_TYPE = "http://schemas.microsoft.com/mapi/proptag/0x370E001F"
'=======================================================================================
' AddNode()
'
' Adds a tag-and-text node to an existing XML
'
' Arguments:
' parent: the parent node
' tag: the tag name
' text: the text
' Returns:
' the parent
'========================================================================================
Private Function AddNode(parent As MSXML2.IXMLDOMNode, tag As String, Text As String)
Dim n As MSXML2.IXMLDOMNode
Dim dom As MSXML2.DOMDocument60
Set dom = parent.OwnerDocument
Set n = dom.createElement(tag)
n.appendChild dom.createTextNode(Text)
parent.appendChild n
Set AddNode = parent
End Function
'=======================================================================================
' Post2osTicket()
'
' Reads a currently selected MailItem and posts it to osTicket using osTicket XML API
'=======================================================================================
Sub Post2osTicket()
Dim myMsg As MailItem 'The MailItem
Dim xmlTicket As DOMDocument60 'A new XML document for the ticket
Dim nodeTicket As MSXML2.IXMLDOMNode 'The root element
Dim n As MSXML2.IXMLDOMNode 'A node we may be knitting
Dim http As MSXML2.ServerXMLHTTP60 'The http connection to osTicket host
Dim i As Integer 'Attachment iterator
Dim FromAddress As String 'Sender's address in SMTP form
Dim oFile As Attachment 'An attachment we may be processing
Dim sTmpFile As String 'A temporary file for attachment storage
Dim fs As Object 'FileSystem object for scripting purpose
Dim nAtt As MSXML2.IXMLDOMNode 'The <attachments> node
Dim a As MSXML2.IXMLDOMAttribute 'An attribute we may be populating
Dim data As Object 'A binary stream to access attachment data
Set myMsg = Application.ActiveExplorer.Selection(1)
Set xmlTicket = New DOMDocument60
Set nodeTicket = xmlTicket.createElement("ticket")
Set xmlTicket.DocumentElement = nodeTicket
If myMsg.SenderEmailType = "EX" Then
'Exchange address needs some tweaking. This requires Outlook >= 2010
FromAddress = myMsg.Sender.GetExchangeUser().PrimarySmtpAddress
Else
FromAddress = myMsg.SenderEmailAddress
End If
'Populate the basic properties
AddNode nodeTicket, "name", myMsg.SenderName
AddNode nodeTicket, "email", FromAddress
AddNode nodeTicket, "subject", myMsg.Subject
'The message is inside a CDATA node
Set n = xmlTicket.createElement("message")
n.appendChild xmlTicket.createCDATASection(myMsg.Body)
nodeTicket.appendChild n
'I add attachment branch only if there are any
If myMsg.Attachments.Count > 0 Then
Set fs = CreateObject("Scripting.FileSystemObject")
Set nAtt = xmlTicket.createElement("attachments")
nodeTicket.appendChild nAtt
For i = 1 To myMsg.Attachments.Count
Set oFile = myMsg.Attachments.Item(i)
'I only add attachments up to a limit in size
If oFile.Size <= MAX_ATTACHMENT Then
sTmpFile = fs.GetTempName
oFile.SaveAsFile sTmpFile
Set n = xmlTicket.createElement("file")
nAtt.appendChild n
'Attachment data is always base64-coded
n.dataType = "bin.base64"
'The ADODB.Stream tweak allows to read binary files
Set data = CreateObject("ADODB.Stream")
data.Type = 1 'Binary
data.Open
data.LoadFromFile sTmpFile
'MSXML will base64-code it for us
n.nodeTypedValue = data.Read
'Using the bin.base64 structure means adding namespace'd attributes.
'For some reason, osTicket will complain for each extra attribute, so
'we get to clean up
n.Attributes.removeNamedItem "dt:dt"
Set a = xmlTicket.createAttribute("name")
a.Value = oFile.FileName
n.Attributes.setNamedItem a
'For some reason, getting the content-type is very unclear in Outlook
Set a = xmlTicket.createAttribute("type")
a.Value = oFile.PropertyAccessor.GetProperty(PR_ATTACH_CONTENT_TYPE)
n.Attributes.setNamedItem a
Set a = xmlTicket.createAttribute("encoding")
a.Value = "base64"
n.Attributes.setNamedItem a
Kill sTmpFile
End If
Next
End If
Set http = New MSXML2.ServerXMLHTTP60
http.Open "POST", HOST_NAME & "/api/http.php/tickets.xml", False
http.setRequestHeader "X-API-Key", API_KEY
http.Send xmlTicket
'If successful, we got the ticket id as a response text
Debug.Print http.responseText
End Sub