Forward email as Ticket - Internal Users

7 Comments

  • xdoomx
    Comment actions Permalink

    It's taken me 3 days to write code similar to this!! Arrrrgh. Wish I'd searched here first.

    0
  • Leo Norakidze
    Comment actions Permalink

    Hi Andrew, 

     

    This is great thank you for sharing it. 

    How do i modify this code so that requester's first name and last name(Display name) is put after thee "#requester "....

    strbody = "#requester " & smtpAddress & vbNewLine & vbNewLine & objItem.Body

     

    Many thanks,

    Leo

    0
  • Paul Dalton
    Comment actions Permalink

    I know this is old but this post just saved my life. I modified the code per Leo's request above. VBA isn't my strong suit so it's probably not the most elegant way, but it works...

     

    Public Sub SendToZD_IT()

    Dim Session As Outlook.NameSpace
    Dim currentExplorer As Explorer
    Dim Selection As Selection
    Dim currentItem As Object
    Dim currentMail As MailItem
    Dim smtpAddress As String
    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 AddSpace As String


    Set currentExplorer = Application.ActiveExplorer
    Set Selection = currentExplorer.Selection
    helpdeskaddress = "ENTER YOUR RECIPIENT EMAIL ADDRESS HERE"
    Set objItem = GetCurrentItem()
    Set objMail = objItem.Forward

    'for all items do...
    For Each currentItem In Selection
    If currentItem.Class = olMail Then
    Set currentMail = currentItem
    smtpAddress = GetSmtpAddress(currentMail)
    UserName = GetDisplayName(currentMail)
    AddSpace = Space(1)


    strbody = "#requester " & smtpAddress & AddSpace & UserName & vbNewLine & vbNewLine & objItem.Body
    objMail.To = helpdeskaddress
    objMail.Subject = objItem.Subject
    objMail.Body = strbody
    'remove the comment from below to display the message before sending
    'objMail.Display
    'Automatically Send the ticket
    objMail.Send
    End If
    Next

    End Sub
    Public Function GetSmtpAddress(mail As MailItem)
    On Error GoTo On_Error

    GetSmtpAddress = ""

    Dim Report As String
    Dim Session As Outlook.NameSpace
    Set Session = Application.Session

    If mail.SenderEmailType <> "EX" Then
    GetSmtpAddress = mail.SenderEmailAddress
    Else
    Dim senderEntryID As String
    Dim sender As AddressEntry
    Dim PR_SENT_REPRESENTING_ENTRYID As String

    PR_SENT_REPRESENTING_ENTRYID = "http://schemas.microsoft.com/mapi/proptag/0x00410102"

    senderEntryID = mail.PropertyAccessor.BinaryToString( _
    mail.PropertyAccessor.GetProperty( _
    PR_SENT_REPRESENTING_ENTRYID))

    Set sender = Session.GetAddressEntryFromID(senderEntryID)
    If sender Is Nothing Then
    Exit Function
    End If

    If sender.AddressEntryUserType = olExchangeUserAddressEntry Or _
    sender.AddressEntryUserType = olExchangeRemoteUserAddressEntry Then

    Dim exchangeUser As exchangeUser
    Set exchangeUser = sender.GetExchangeUser()

    If exchangeUser Is Nothing Then
    Exit Function
    End If

    GetSmtpAddress = exchangeUser.PrimarySmtpAddress
    Exit Function
    Else
    Dim PR_SMTP_ADDRESS
    PR_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    GetSmtpAddress = sender.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
    End If

    End If

    Exiting:
    Exit Function
    On_Error:
    MsgBox "error=" & Err.Number & " " & Err.Description
    Resume Exiting

    End Function
    Public Function GetDisplayName(mail As MailItem)
    On Error GoTo On_Error

    GetDisplayName = ""

    Dim Report As String
    Dim Session As Outlook.NameSpace
    Set Session = Application.Session

    If mail.SenderEmailType <> "EX" Then
    GetDisplayName = mail.SenderName
    Else
    Dim senderEntryID As String
    Dim sender As AddressEntry
    Dim PR_SENT_REPRESENTING_ENTRYID As String

    PR_SENT_REPRESENTING_ENTRYID = "http://schemas.microsoft.com/mapi/proptag/0x00410102"

    senderEntryID = mail.PropertyAccessor.BinaryToString( _
    mail.PropertyAccessor.GetProperty( _
    PR_SENT_REPRESENTING_ENTRYID))

    Set sender = Session.GetAddressEntryFromID(senderEntryID)
    If sender Is Nothing Then
    Exit Function
    End If

    If sender.AddressEntryUserType = olExchangeUserAddressEntry Or _
    sender.AddressEntryUserType = olExchangeRemoteUserAddressEntry Then

    Dim exchangeUser As exchangeUser
    Set exchangeUser = sender.GetExchangeUser()

    If exchangeUser Is Nothing Then
    Exit Function
    End If

    GetDisplayName = exchangeUser.Name
    Exit Function
    Else
    Dim PR_Name
    PR_Name = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    GetDisplayName = sender.PropertyAccessor.GetProperty(PR_Name)
    End If

    End If

    Exiting:
    Exit Function
    On_Error:
    MsgBox "error=" & Err.Number & " " & Err.Description
    Resume Exiting

    End Function

    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

    0
  • Jessie Schutz
    Comment actions Permalink

    Hey Paul! I'm glad you were able to get it working, and thanks for coming back to share your solution. :)

    0
  • Chris Tolhurst
    Comment actions Permalink

    Hi,

    Just found this script which works great except it seems to strip out any inline images in the email body. Is there any way to preserve the message body and include any images?

    Thanks

    0
  • Chris Tolhurst
    Comment actions Permalink

    A bit of searching and answered my own question, just need to use HTMLBody instead of Body

    This code should forward the message and keep the formatting the same

    Public Sub Zendesk()

    Dim Session As Outlook.NameSpace
    Dim currentExplorer As Explorer
    Dim Selection As Selection
    Dim currentItem As Object
    Dim currentMail As MailItem
    Dim smtpAddress As String
    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

    Set currentExplorer = Application.ActiveExplorer
    Set Selection = currentExplorer.Selection
    helpdeskaddress = "ENTER YOUR RECIPIENT EMAIL ADDRESS HERE"
    Set objItem = GetCurrentItem()
    Set objMail = objItem.Forward

    'for all items do...
    For Each currentItem In Selection
    If currentItem.Class = olMail Then
    Set currentMail = currentItem
    smtpAddress = GetSmtpAddress(currentMail)
    'MsgBox "SMTP Address is " & smtpAddress
    strbody = "#requester " & smtpAddress & vbNewLine & vbNewLine & objItem.HTMLBody
    objMail.To = helpdeskaddress
    objMail.Subject = objItem.Subject
    objMail.HTMLBody = strbody & objMail.HTMLBody
    'remove the comment from below to display the message before sending
    objMail.Display
    'Automatically Send the ticket
    'objMail.Send
    End If
    Next

    End Sub
    Public Function GetSmtpAddress(mail As MailItem)
    On Error GoTo On_Error

    GetSmtpAddress = ""

    Dim Report As String
    Dim Session As Outlook.NameSpace
    Set Session = Application.Session

    If mail.SenderEmailType <> "EX" Then
    GetSmtpAddress = mail.SenderEmailAddress
    Else
    Dim senderEntryID As String
    Dim sender As AddressEntry
    Dim PR_SENT_REPRESENTING_ENTRYID As String

    PR_SENT_REPRESENTING_ENTRYID = "http://schemas.microsoft.com/mapi/proptag/0x00410102"

    senderEntryID = mail.PropertyAccessor.BinaryToString( _
    mail.PropertyAccessor.GetProperty( _
    PR_SENT_REPRESENTING_ENTRYID))

    Set sender = Session.GetAddressEntryFromID(senderEntryID)
    If sender Is Nothing Then
    Exit Function
    End If

    If sender.AddressEntryUserType = olExchangeUserAddressEntry Or _
    sender.AddressEntryUserType = olExchangeRemoteUserAddressEntry Then

    Dim exchangeUser As exchangeUser
    Set exchangeUser = sender.GetExchangeUser()

    If exchangeUser Is Nothing Then
    Exit Function
    End If

    GetSmtpAddress = exchangeUser.PrimarySmtpAddress
    Exit Function
    Else
    Dim PR_SMTP_ADDRESS
    PR_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    GetSmtpAddress = sender.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
    End If

    End If

    Exiting:
    Exit Function
    On_Error:
    MsgBox "error=" & Err.Number & " " & Err.Description
    Resume Exiting

    End Function

    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





    0
  • Nicole - Community Manager
    Comment actions Permalink

    Glad you got it figured out, Chris! Thanks for sharing the answer here with everyone. 

    0

Post is closed for comments.

Powered by Zendesk