I have been working on this macro for outlook 2007 - 2010 for a while now.. it takes the selected(highlighted) email in outlook and start creating ticket in the admin panel...
function of script: (launch IE in background, login to hesk, open new ticket page, insert e-mails sender name, senders e-mail address, subject, and message (some filtering and formatting on the e-mail body).. The macro will contain your UN and PW so please be aware of the possible security risk, it wouldn't be difficult to modify the code to wait until you login yourself...
Anyone interested in this? Would love for someone to use it and provide some feedback... I'm thinking there is probably a way to modify this further to track replies.... maybe have the script ask for category and submit the ticket itself and pull the tracking ID and add it to the original message... then have another macro to add any text above that line with the tracking id to the reply section....
just tested with default outlook 2007 setup and fresh installation of hesk 2.4.1 works on my outlook 2010 at work as well.
look for "username" and "password" you must fill this out in the code for it to work. You also must modify the 2 sections with the URL to your hesk installation.
Code: Select all
Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" _
(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Global Const SW_MAXIMIZE = 3
Global Const SW_SHOWMINIMIZED = 2
Global Const SW_SHOWNORMAL = 1
Sub HelpdeskNewTicket()
Dim helpdeskaddress As String
Dim objMail As Outlook.MailItem
Dim strbody As String
Dim oldmsg As String
Dim senderaddress As String
Dim addresstype As Integer
Dim ie As Object
Dim sResult As String
Dim dtTimer As Date
Dim lAddTime As Long
Set objItem = GetCurrentItem()
If objItem.BodyFormat = olFormatHTML Then
txt = objItem.Body
strt = InStr(txt, "HYPERLINK")
Do Until strt = 0
nd = InStr(strt + 13, txt, """")
txt = Left(txt, strt - 1) & Mid(txt, nd + 1)
strt = InStr(txt, "HYPERLINK")
Loop
End If
If objItem.BodyFormat = olFormatRichText Then
txt = objItem.Body
strt = InStr(txt, " HYPERLINK")
Do Until strt = 0
nd = InStr(strt + 13, txt, """")
txt = Left(txt, strt - 1) & Mid(txt, nd + 2)
strt = InStr(txt, " HYPERLINK")
Loop
End If
' Sender E=mail Address
senderaddress = objItem.SenderEmailAddress
'Searches for @ in the email address to determine if it is an exchange user
addresstype = InStr(senderaddress, "@")
' If the address is an Exchange DN use the Senders Name
If addresstype = 0 Then
senderaddress = objItem.SenderName
End If
Const sOVIDURL As String = "http://heskurl.com/admin"
Const lREADYSTATE_COMPLETE As Long = 4
Set ie = CreateObject("InternetExplorer.Application")
ie.navigate sOVIDURL
dtTimer = Now
lAddTime = TimeValue("00:00:20")
Do Until ie.readystate = lREADYSTATE_COMPLETE And Not ie.busy
DoEvents
If dtTimer + lAddTime > Now Then Exit Do
Loop
ie.document.getElementById("user").Value = "username"
ie.document.getElementById("pass").Value = "password"
ie.document.forms(0).submit
Do Until ie.readystate = lREADYSTATE_COMPLETE And Not ie.busy
DoEvents
If dtTimer + lAddTime > Now Then Exit Do
Loop
ie.navigate "http://heskurl.com/admin/new_ticket.php"
Do Until ie.readystate = lREADYSTATE_COMPLETE And Not ie.busy
DoEvents
If dtTimer + lAddTime > Now Then Exit Do
Loop
While ie.busy
DoEvents
Wend
ie.document.getElementById("name").Value = objItem.SenderName
ie.document.getElementById("subject").Value = objItem.Subject
ie.document.getElementById("Email").Value = objItem.SenderEmailAddress
If objItem.BodyFormat = olFormatHTML Then
ie.document.getElementById("message").Value = Replace(txt, vbCrLf & vbCrLf, vbCrLf)
End If
If objItem.BodyFormat = olFormatPlain Then
ie.document.getElementById("message").Value = objItem.Body
End If
If objItem.BodyFormat = olFormatRichText Then
ie.document.getElementById("message").Value = txt
End If
ie.Visible = True
apiShowWindow ie.hwnd, SW_MAXIMIZE
dtTimer = Now
lAddTime = TimeValue("00:00:20")
Set ie = Nothing ' If you want to close it.
'Dim PageNumber As Object
Set objItem = Nothing
Set objMail = Nothing
End Sub
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = _
objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = _
objApp.ActiveInspector.CurrentItem
Case Else
End Select
End Function
