/build/static/layout/Breadcrumb_cap_w.png

Custom Outlook Email Form

I have made two Custom forms in Outlook

One that allow the Tech to create a new ticket and the other which captures the currently selected email and fills the form in.

Both forms pull information dynamically from KACE and also Active Directory.

You must download the MYSQL DB Connection Drivers and setup a DSN for the connection to KACE to do this.

Below is the form in design mode:

Below is how we distrubute the form. We used the publish to organzational forms library to accomplish this.

Also the code below uses our custom fields, which can simply be removed or replaced with your custom fields. This will not work out of the box but its will get 90% of the way there and just requires a little tweaking to work with your environment.

CODE For Non Capture Form:

Function Item_Send()
Const olFormatPlain = 1
Const olDiscard = 1

Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set ConAsset = frmMsg.controls("txtAsset")
Set ConMachine = frmMsg.controls("txtMachine")



If ConAsset.Value = "" And ConMachine.Value = "" Then
    If Item.CC = "" Then
    strBody = "@owner=" & Item.UserProperties("ticketowner") & vbCrLf & "@submitter=" & Item.UserProperties("ticketsubmiter") & vbCrLf & "@status=" & Item.UserProperties("ticketstatus") & vbCrLf & "@impact=" & Item.UserProperties("ticketseverity") & vbCrLf & vbCrLf & "@priority=" & Item.UserProperties("ticketpriority") & vbCrLf & "@category=" & Item.UserProperties("ticketcategory") & vbCrLf & "@location=" & Item.UserProperties("ticketlocation") & vbCrLf & "@company=" & Item.UserProperties("ticketcompany") & vbCrLf & Item.Body
    Else
    strBody = "@owner=" & Item.UserProperties("ticketowner") & vbCrLf & "@submitter=" & Item.UserProperties("ticketsubmiter") & vbCrLf & "@cc_list=" & Item.CC & vbCrLf & "@status=" & Item.UserProperties("ticketstatus") & vbCrLf & "@impact=" & Item.UserProperties("ticketseverity") & vbCrLf & vbCrLf & "@priority=" & Item.UserProperties("ticketpriority") & vbCrLf & "@category=" & Item.UserProperties("ticketcategory") & vbCrLf & "@location=" & Item.UserProperties("ticketlocation") & vbCrLf & "@company=" & Item.UserProperties("ticketcompany") & vbCrLf & Item.Body
    End If
Else
        If ConAsset.Value = "" Then
            If Item.CC = "" Then
            strBody = "@owner=" & Item.UserProperties("ticketowner") & vbCrLf & "@submitter=" & Item.UserProperties("ticketsubmiter") & vbCrLf & "@status=" & Item.UserProperties("ticketstatus") & vbCrLf & "@impact=" & Item.UserProperties("ticketseverity") & vbCrLf & vbCrLf & "@priority=" & Item.UserProperties("ticketpriority") & vbCrLf & "@machine=" & Item.UserProperties("ticketmachine") & vbCrLf & "@category=" & Item.UserProperties("ticketcategory") & vbCrLf & "@location=" & Item.UserProperties("ticketlocation") & vbCrLf & "@company=" & Item.UserProperties("ticketcompany") & vbCrLf & Item.Body
            Else
            strBody = "@owner=" & Item.UserProperties("ticketowner") & vbCrLf & "@submitter=" & Item.UserProperties("ticketsubmiter") & vbCrLf & "@cc_list=" & Item.CC & vbCrLf & "@status=" & Item.UserProperties("ticketstatus") & vbCrLf & "@impact=" & Item.UserProperties("ticketseverity") & vbCrLf & vbCrLf & "@priority=" & Item.UserProperties("ticketpriority") & vbCrLf & "@machine=" & Item.UserProperties("ticketmachine") & vbCrLf & "@category=" & Item.UserProperties("ticketcategory") & vbCrLf & "@location=" & Item.UserProperties("ticketlocation") & vbCrLf & "@company=" & Item.UserProperties("ticketcompany") & vbCrLf & Item.Body
            End If
        Else
            If ConMachine.Value = "" Then
                If Item.CC = "" Then
                strBody = "@owner=" & Item.UserProperties("ticketowner") & vbCrLf & "@submitter=" & Item.UserProperties("ticketsubmiter") & vbCrLf & "@status=" & Item.UserProperties("ticketstatus") & vbCrLf & "@impact=" & Item.UserProperties("ticketseverity") & vbCrLf & vbCrLf & "@priority=" & Item.UserProperties("ticketpriority") & vbCrLf & "@asset=" & Item.UserProperties("ticketasset") & vbCrLf & "@category=" & Item.UserProperties("ticketcategory") & vbCrLf & "@location=" & Item.UserProperties("ticketlocation") & vbCrLf & "@company=" & Item.UserProperties("ticketcompany") & vbCrLf & Item.Body
                Else
                strBody = "@owner=" & Item.UserProperties("ticketowner") & vbCrLf & "@submitter=" & Item.UserProperties("ticketsubmiter") & vbCrLf & "@cc_list=" & Item.CC & vbCrLf & "@status=" & Item.UserProperties("ticketstatus") & vbCrLf & "@impact=" & Item.UserProperties("ticketseverity") & vbCrLf & vbCrLf & "@priority=" & Item.UserProperties("ticketpriority") & vbCrLf & "@asset=" & Item.UserProperties("ticketasset") & vbCrLf & "@category=" & Item.UserProperties("ticketcategory") & vbCrLf & "@location=" & Item.UserProperties("ticketlocation") & vbCrLf & "@company=" & Item.UserProperties("ticketcompany") & vbCrLf & Item.Body
                End If
            Else
                If Item.CC = "" Then
                strBody = "@owner=" & Item.UserProperties("ticketowner") & vbCrLf & "@submitter=" & Item.UserProperties("ticketsubmiter") & vbCrLf & "@status=" & Item.UserProperties("ticketstatus") & vbCrLf & "@impact=" & Item.UserProperties("ticketseverity") & vbCrLf & vbCrLf & "@priority=" & Item.UserProperties("ticketpriority") & vbCrLf & "@asset=" & Item.UserProperties("ticketasset") & vbCrLf & "@machine=" & Item.UserProperties("ticketmachine") & vbCrLf & "@category=" & Item.UserProperties("ticketcategory") & vbCrLf & "@location=" & Item.UserProperties("ticketlocation") & vbCrLf & "@company=" & Item.UserProperties("ticketcompany") & vbCrLf & Item.Body
                Else
                strBody = "@owner=" & Item.UserProperties("ticketowner") & vbCrLf & "@submitter=" & Item.UserProperties("ticketsubmiter") & vbCrLf & "@cc_list=" & Item.CC & vbCrLf & "@status=" & Item.UserProperties("ticketstatus") & vbCrLf & "@impact=" & Item.UserProperties("ticketseverity") & vbCrLf & vbCrLf & "@priority=" & Item.UserProperties("ticketpriority") & vbCrLf & "@asset=" & Item.UserProperties("ticketasset") & vbCrLf & "@machine=" & Item.UserProperties("ticketmachine") & vbCrLf & "@category=" & Item.UserProperties("ticketcategory") & vbCrLf & "@location=" & Item.UserProperties("ticketlocation") & vbCrLf & "@company=" & Item.UserProperties("ticketcompany") & vbCrLf & Item.Body
                End If
            End If
        End If
End If

Item.CC = ""

Set NewMail = Application.CreateItem(0)
NewMail.BodyFormat = olFormatPlain

' transfer subject
NewMail.Subject = Item.Subject

' transfer recipients
For Each objRecip in Item.Recipients
NewMail.Recipients.Add objRecip.Address
Next

' build body from custom fields
NewMail.Body = strBody

' send it

NewMail.Send

' discard the original
Item_Send = False
Set insp = Item.GetInspector
insp.Close olDiscard

End Function



Function Item_Open()
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set ConSubmitter = frmMsg.controls("txtSubmitter")
Set ConAsset = frmMsg.controls("txtAsset")
Set ConMachine = frmMsg.controls("txtMachine")
Set ConOwner = frmMsg.controls("txtOwner")
If ConSubmitter.Value = "" Then
   ConAsset.Enabled = False
   ConMachine.Enabled = False
End If
ConOwner.Value = Application.GetNameSpace("MAPI").CurrentUser
Get_Categories
Get_Statuses
Get_Priorities
Get_Severities
Get_Owners
Get_Locations
Get_Companies
End Function

Function Get_Owners
dim oConn
dim query                  ' Query
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set Control = frmMsg.controls("txtOwner")

' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query
Control.AddItem ""
set rs = oConn.Execute("SELECT FULL_NAME FROM USER WHERE ROLE_ID = 1 AND USER_NAME <> 'admin' ORDER BY FULL_NAME;")
Do While Not rs.EOF
    For i=0 to num_fields
        myItemtoAdd = rs.fields.Item(i)
        Control.AddItem myItemtoAdd
        rs.movenext
    next
Loop

rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing

End Function

Function Get_Tickets
dim oConn
dim query                  ' Query
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set Control = frmMsg.controls("txtTickID")

' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query

NumItems = (Control.ListCount - 1)

For i = (NumItems) To 0 Step -1
Control.RemoveItem (i)
next
set rs = oConn.Execute("SELECT ID, TITLE FROM HD_TICKET WHERE HD_STATUS_ID <> 2 ORDER BY TITLE;")

fields=rs.GetRows
arrCount = uBound(fields, 2)

    For i=0 to arrCount
    control.additem fields(0,i)
    control.list(i,1) = fields(1,i)
    next



rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing
End Function


Function Get_Categories
dim oConn
dim query                  ' Query
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set Control = frmMsg.controls("txtcategory")

' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query
set rs = oConn.Execute("SELECT NAME FROM HD_CATEGORY ORDER BY NAME;")
Do While Not rs.EOF
    For i=0 to num_fields
        myItemtoAdd = rs.fields.Item(i)
        Control.AddItem myItemtoAdd
        rs.movenext
    next
Loop

rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing
End Function

Function Get_Statuses
dim oConn
dim query                  ' Query
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set Control = frmMsg.controls("txtStatus")

' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query
set rs = oConn.Execute("SELECT NAME FROM HD_STATUS;")
Do While Not rs.EOF
    For i=0 to num_fields
        myItemtoAdd = rs.fields.Item(i)
        Control.AddItem myItemtoAdd
        rs.movenext
    next
Loop

rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing
End Function

Function Get_Priorities
dim oConn
dim query                  ' Query
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set Control = frmMsg.controls("priority")

' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query
set rs = oConn.Execute("SELECT NAME FROM HD_PRIORITY;")
Do While Not rs.EOF
    For i=0 to num_fields
        myItemtoAdd = rs.fields.Item(i)
        Control.AddItem myItemtoAdd
        rs.movenext
    next
Loop

rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing
End Function

Function Get_Companies
dim oConn
dim query                  ' Query
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set Control = frmMsg.controls("txtCompany")

' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query
set rs = oConn.Execute("SELECT HD_CUSTOM_FIELDS.VALUES FROM HD_CUSTOM_FIELDS WHERE NAME = 'CUSTOM_2';")
Control.PossibleValues = rs.fields.Item(0)
rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing
End Function


Function Get_Locations
dim oConn
dim query                  ' Query
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set Control = frmMsg.controls("txtLocation")

' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query
set rs = oConn.Execute("SELECT HD_CUSTOM_FIELDS.VALUES FROM HD_CUSTOM_FIELDS WHERE NAME = 'CUSTOM_1';")
Control.PossibleValues = rs.fields.Item(0)
rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing
End Function



Function Get_Severities
dim oConn
dim query                  ' Query
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set Control = frmMsg.controls("txtSeverity")

' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query
set rs = oConn.Execute("SELECT NAME FROM HD_IMPACT;")
Do While Not rs.EOF
    For i=0 to num_fields
        myItemtoAdd = rs.fields.Item(i)
        Control.AddItem Trim(cStr(myItemtoAdd))
        rs.movenext
    next
Loop

rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing
End Function


Sub Item_CustomPropertyChange(ByVal Name)
    Select Case Name
        Case "ticketsubmiter"
            Set oConn = CreateObject("ADODB.Connection")
            oConn.Open "DSN=MySQL"

            Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
            Set ConSubmitter = frmMsg.controls("txtSubmitter")
            Set ConSubject = frmMsg.controls("txtSubject")
            Set ConLocation = frmMsg.controls("txtLocation")
            Set ConAsset = frmMsg.controls("txtAsset")
            Set ConMachine = frmMsg.controls("txtMachine")
            Set ConUpdate = frmMsg.controls("cbxUpdate")
            set rs = oConn.Execute("SELECT USER_NAME FROM ORG1.USER WHERE USER_NAME = '" & ConSubmitter.Value & "';")
                                    
            If rs.EOF Then
                set rs = oConn.Execute("SELECT USER_NAME FROM ORG1.USER WHERE USER_NAME LIKE '%" & ConSubmitter.Value & "%';")
                If rs.EOF Then
                    MsgBox "User: " & ConSubmitter.Value & " Not Found Please Check Spelling"
                Else
                    NumItems = (ConSubmitter.ListCount - 1)

                    For i = (NumItems) To 0 Step -1
                        ConSubmitter.RemoveItem (i)
                    next


                    Do While Not rs.EOF
                        For i=0 to num_fields
                            myItemtoAdd = rs.fields.Item(i)
                            ConSubmitter.AddItem myItemtoAdd
                            rs.movenext
                        next
                    Loop

                End If
            Else
                set rs2 = oConn.Execute("SELECT FULL_NAME FROM ORG1.USER WHERE USER_NAME = '" & ConSubmitter.Value & "';")

                If ConSubmitter.Value = "" Then
                    msgbox "Please Enter an User Name"
                Else
                    
                    Get_Machine_Names(ConSubmitter.Value)
                    Get_Location
                    If ConUpdate = False Then
                    ConSubject.Value = rs2.fields.item(0) & " -  - " & ConLocation.Value
                    Else
                    End If
                End If
            End If

        Case "ticketmachine"
            Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
            Set ConSubmitter = frmMsg.controls("txtSubmitter")
            Set ConAsset = frmMsg.controls("txtAsset")
            Set ConMachine = frmMsg.controls("txtMachine")
            Dim mID    
                If ConSubmitter.Value = "" or ConMachine.Value = "" Then
                    msgbox "Please Enter an User Name and Select a Machine"
                Else
                      mID = Get_Machine_IDs(ConMachine.Value)
                    Get_Assets(mID)
                End If
        Case "ticketcategory"
            Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
            Set ConOwner = frmMsg.controls("txtOwner")
            Set ConCategory = frmMsg.controls("txtCategory")
            Set ConUpdate = frmMsg.controls("cbxUpdate")
            If ConUpdate = True Then
            Else
                If ConCategory = "Other" or ConCategory = "Project A" or ConCategory = "Project B" or ConCategory = "Project C" or ConCategory = "Project D" Then
                
                Else
                    Set oConn = CreateObject("ADODB.Connection")
                    oConn.Open "DSN=MySQL"
                    ' Execute query
                    set rs = oConn.Execute("SELECT FULL_NAME FROM ORG1.USER INNER JOIN HD_CATEGORY ON USER.ID = HD_CATEGORY.DEFAULT_OWNER_ID WHERE NAME = '" & ConCategory.Value & "';")
                    myItemtoAdd = rs.fields.Item(0)
                    ConOwner.Value = myItemtoAdd
                    rs.close
                    set rs = Nothing
                    oConn.Close
                    set oConn = Nothing
                End If
             End If
        Case "ticketupdate"
            Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
            Set ConTicket = frmMsg.controls("cbxUpdate")
            Set ConTickID = frmMsg.controls("txtTickID")
            Set ConSubject = frmMsg.controls("txtSubject")
            Set ConSubmitter = frmMsg.controls("txtSubmitter")
            Set ConAsset = frmMsg.controls("txtAsset")
            Set ConMachine = frmMsg.controls("txtMachine")
            Set ConOwner = frmMsg.controls("txtOwner")
            Set ConCategory = frmMsg.controls("txtCategory")
            Set ConStatus = frmMsg.controls("txtStatus")
            Set ConPriority = frmMsg.controls("priority")
            Set ConSeverity = frmMsg.controls("txtSeverity")


            NumItems = (ConTickID.ListCount - 1)
            If ConTicket = True Then
                ConTickID.Enabled = True
                ConTickID.Visible = True
                Get_Tickets
            Else
                Item.CC = ""
                ConTickID.Enabled = False
                ConTickID.Visible = False
                ConSubject.Value = ""
                ConSubmitter.Value = ""
                ConAsset.Value = ""
                ConAsset.Enabled = False
                ConMachine.Value = ""
                ConMachine.Enabled = False
                ConOwner.Value = Application.GetNameSpace("MAPI").CurrentUser
                ConCategory.Value = ""
                ConStatus.Value = "Opened"
                ConPriority.Value = "Low"
                ConSeverity.Value = "Low - 1 to 2 people effected - They Can Still Work"

                For i = (NumItems) To 0 Step -1
                    ConTickID.RemoveItem (i)
                next

            End If
        Case "ticketID"
            
            Set oConn = CreateObject("ADODB.Connection")
            oConn.Open "DSN=MySQL"
            Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
            Set ConSubmitter = frmMsg.controls("txtSubmitter")
            Set ConAsset = frmMsg.controls("txtAsset")
            Set ConMachine = frmMsg.controls("txtMachine")
            Set ConOwner = frmMsg.controls("txtOwner")
            Set ConCategory = frmMsg.controls("txtCategory")
            Set ConStatus = frmMsg.controls("txtStatus")
            Set ConPriority = frmMsg.controls("priority")
            Set ConSeverity = frmMsg.controls("txtSeverity")
            Set ConUpdate = frmMsg.controls("cbxUpdate")
            Set ConSubject = frmMsg.controls("txtSubject")
            Set ConLocation = frmMsg.controls("txtLocation")
            Set ConCompany = frmMsg.controls("txtCompany")
            Set ConID = frmMsg.controls("txtTickID")
            
                If ConUpdate = True Then
                    ConSubject.Value = "[TICK:" & ConID.Column(0) & "] " & ConID.Column(1)
                    
                    set rsSubmitter = oConn.Execute("SELECT USER_NAME FROM ORG1.USER INNER JOIN HD_TICKET ON USER.ID = HD_TICKET.SUBMITTER_ID WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    dsSubmitter = rsSubmitter.fields.Item(0)
                    ConSubmitter.Value = dsSubmitter
                                        
                    set rsLocation = oConn.Execute("SELECT CUSTOM_FIELD_VALUE0 FROM HD_TICKET WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    If rsLocation.EOF Then
                    ConLocation .Value = ""    
                    Else
                    dsLocation = rsLocation.fields.Item(0)
                    ConLocation.Value = dsLocation
                    End If

                    set rsCompany = oConn.Execute("SELECT CUSTOM_FIELD_VALUE1 FROM HD_TICKET WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    If rsCompany.EOF Then
                    ConCompany .Value = ""    
                    Else
                    dsCompany = rsCompany.fields.Item(0)
                    ConCompany.Value = dsCompany
                    End If


                    set rsMachine = oConn.Execute("SELECT NAME FROM ORG1.MACHINE INNER JOIN HD_TICKET ON MACHINE.ID = HD_TICKET.MACHINE_ID WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    If rsMachine.EOF Then
                    ConMachine.Value = ""
                    Else
                    dsMachine = rsMachine.fields.Item(0)
                    ConMachine.Enabled = True
                    ConMachine.Value = dsMachine
                    End If

                    If ConOwner.Value = "" Then
                    Else
                    set rsOwner = oConn.Execute("SELECT FULL_NAME FROM ORG1.USER INNER JOIN HD_TICKET ON USER.ID = HD_TICKET.OWNER_ID WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    dsOwner = rsOwner.fields.Item(0)
                    ConOwner.Value = dsOwner
                    End If
                    set rsCategory = oConn.Execute("SELECT NAME FROM ORG1.HD_CATEGORY INNER JOIN HD_TICKET ON HD_CATEGORY.ID = HD_TICKET.HD_CATEGORY_ID WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    If rsCategory.EOF Then
                    ConCategory.Value = ""
                    Else
                    dsCategory = rsCategory.fields.Item(0)
                    ConCategory.Value = dsCategory
                    End If    
                    set rsStatus = oConn.Execute("SELECT NAME FROM ORG1.HD_STATUS INNER JOIN HD_TICKET ON HD_STATUS.ID = HD_TICKET.HD_STATUS_ID WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    dsStatus = rsStatus.fields.Item(0)
                    ConStatus.Value = dsStatus
                    set rsPriority = oConn.Execute("SELECT NAME FROM ORG1.HD_PRIORITY INNER JOIN HD_TICKET ON HD_PRIORITY.ID = HD_TICKET.HD_PRIORITY_ID WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    dsPriority = rsPriority.fields.Item(0)
                    ConPriority.Value = dsPriority
                    set rsSeverity = oConn.Execute("SELECT NAME FROM ORG1.HD_IMPACT INNER JOIN HD_TICKET ON HD_IMPACT.ID = HD_TICKET.HD_IMPACT_ID WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    dsSeverity = rsSeverity.fields.Item(0)
                    ConSeverity.Value = dsSeverity
                    set rsCC = oConn.Execute("SELECT CC_LIST FROM ORG1.HD_TICKET WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    dsCC = rsCC.fields.Item(0)
                    Item.CC = dsCC
                    

                    set rsAsset = oConn.Execute("SELECT NAME FROM ORG1.ASSET INNER JOIN HD_TICKET ON ASSET.ID = HD_TICKET.ASSET_ID WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    If rsAsset.EOF Then
                    ConAsset.Value = ""    
                    Else
                    dsAsset = rsAsset.fields.Item(0)
                    ConAsset.Enabled = True
                    ConAsset.Value = dsAsset
                    End If

                    rsSubmitter.close
                    set rsSubmitter = Nothing
                    rsAsset.close
                    set rsAsset= Nothing
                    rsMachine.close
                    set rsMachine = Nothing
                      rsOwner.close
                    set rsOwner = Nothing
                    rsCategory.close
                    set rsCategory = Nothing
                    rsStatus.close
                    set rsStatus = Nothing
                    rsPriority.close
                    set rsPriority = Nothing
                    rsSeverity.close
                    set rsSeverity = Nothing
                    rsCC.close
                    Set rsCC = Nothing


                    oConn.Close
                    set oConn = Nothing

                Else

                    
                End If
            
    End Select
    
End Sub


Function Get_Machine_Names(uName)
dim oConn
dim query                  ' Query
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set Control = frmMsg.controls("txtMachine")
Set Control1 = frmMsg.controls("txtAsset")
Set Control2 = frmMsg.controls("cbxUpdate")

Control.Enabled = True
' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query
set rs = oConn.Execute("SELECT NAME FROM MACHINE WHERE USER = '" & uName & "';")

If Control.Enabled = True Then
Else
Control.Value = ""
Control1.Value = ""
End If

NumItems = (Control.ListCount - 1)

For i = (NumItems) To 0 Step -1
Control.RemoveItem (i)
next


Do While Not rs.EOF
    For i=0 to num_fields
        myItemtoAdd = rs.fields.Item(i)
        Control.AddItem myItemtoAdd
        rs.movenext
    next
Loop


rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing
End Function

Function Get_Machine_IDs(uName)
dim oConn
dim query                  ' Query
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query
set rs = oConn.Execute("SELECT ID FROM MACHINE WHERE NAME = '" & uName & "';")

machineID = rs.fields.Item(0)
        
rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing
Get_Machine_IDs = machineID
End Function
 
Function Get_Assets(mID)
dim oConn
dim query                  ' Query
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set Control = frmMsg.controls("txtAsset")
Control.Enabled = True
' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query
set rs = oConn.Execute("SELECT Name FROM ASSET WHERE MAPPED_ID = " & mID & ";")

NumItems = (Control.ListCount - 1)

For i = (NumItems) To 0 Step -1
Control.RemoveItem (i)
next

Do While Not rs.EOF
    For i=0 to num_fields
        myItemtoAdd = rs.fields.Item(i)
        Control.AddItem myItemtoAdd
        rs.movenext
    next
Loop

rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing

End Function

Function Get_Location
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set ConCompany = frmMsg.controls("txtCompany")
Set ConLocation = frmMsg.controls("txtLocation")
Set ConSubmitter = frmMsg.controls("txtSubmitter")

Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strTarget = "LDAP://" & strDNSDomain
' Connect to Ad Provider
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCmd = CreateObject("ADODB.Command")
Set objCmd.ActiveConnection = objConnection
objCmd.CommandText = "SELECT physicalDeliveryOfficeName FROM '" & strTarget & "' WHERE objectCategory = 'user' and sAMAccountName = '"& ConSubmitter.Value &"'"
Const ADS_SCOPE_SUBTREE = 2
objCmd.Properties("Page Size") = 100
objCmd.Properties("Timeout") = 30
objCmd.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCmd.Properties("Cache Results") = False
Set objRecordSet = objCmd.Execute
ConLocation.Value = objRecordSet.fields.Item(0)
If objRecordSet.fields.Item(0) = "Corporate" Then
     ConCompany.Value = "99"
Else
    If Instr(objRecordSet.fields.Item(0), "AT ") <> 0 Then
         ConCompany.Value = "80"
    Else
     ConCompany.Value = "10"
    End If
End If
End Function

Code For Capture Form:

Function Get_Email_Body()
Dim oApp
Dim oExp
Dim oSel
Dim strMessageClass
Dim oMailItem

Set oSel = Application.ActiveExplorer.Selection
    If oSel.count > 1 Then
        msgbox "Please Only Select One Email At A Time"
    Else
        strMessageClass = oSel.Item(1).MessageClass
        If (strMessageClass <> "IPM.Note") Then ' Mail Entry.
            msgbox "Only E-mails Can Be Selected"
        Else
            Get_Email_Body = oSel.Item(1).Body    
        End If
      End If
End Function

Function Get_Email_CC()
Dim oApp
Dim oExp
Dim oSel
Dim strMessageClass
Dim oMailItem

Set oSel = Application.ActiveExplorer.Selection
    If oSel.count > 1 Then
        msgbox "Please Only Select One Email At A Time"
    Else
        strMessageClass = oSel.Item(1).MessageClass
        If (strMessageClass <> "IPM.Note") Then ' Mail Entry.
            msgbox "Only E-mails Can Be Selected"
        Else
            Get_Email_CC = oSel.Item(1).CC    
        End If
      End If
End Function



Function Get_Email_Subject()
Dim oApp
Dim oExp
Dim oSel
Dim strMessageClass
Dim oMailItem

Set oSel = Application.ActiveExplorer.Selection
    If oSel.count > 1 Then
    Else
        strMessageClass = oSel.Item(1).MessageClass
        If (strMessageClass <> "IPM.Note") Then ' Mail Entry.
        Else
        Get_Email_Subject = oSel.Item(1).Subject    
        End If
      End If

End Function

Function Get_Email_Sender_FullName()
Dim oApp
Dim oExp
Dim oSel
Dim strMessageClass
Dim oMailItem

Set oSel = Application.ActiveExplorer.Selection
    If oSel.count > 1 Then
    Else
        strMessageClass = oSel.Item(1).MessageClass
        If (strMessageClass <> "IPM.Note") Then ' Mail Entry.
        Else
        Get_Email_Sender_FullName = oSel.Item(1).Sender    
        End If
      End If

End Function




Function Get_Email_Sender()
Dim oApp
Dim oExp
Dim oSel
Dim strMessageClass
Dim oMailItem
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"

Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set ConSubmitter = frmMsg.controls("txtSubmitter")

Set oSel = Application.ActiveExplorer.Selection
    If oSel.count > 1 Then
    Else
        strMessageClass = oSel.Item(1).MessageClass
        If (strMessageClass <> "IPM.Note") Then ' Mail Entry.
            msgbox "Only E-mails Can Be Selected"
        Else    
        End If
      End If

set rs = oConn.Execute("SELECT USER_NAME FROM ORG1.USER WHERE FULL_NAME = '" & oSel.Item(1).Sender & "';")

                        
            If rs.EOF Then
                MsgBox "User: " & oSel.Item(1).Sender & ", Make Sure You Selected The Right E-Mail"
            Else
            
                ConSubmitter.Value = rs.fields.Item(0)
                Get_Machine_Names(ConSubmitter.Value)
            End If
rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing
End Function

Function Item_Send()
Const olFormatPlain = 1
Const olDiscard = 1

Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set ConAsset = frmMsg.controls("txtAsset")
Set ConMachine = frmMsg.controls("txtMachine")

If ConAsset.Value = "" And ConMachine.Value = "" Then
    If Item.CC = "" Then
    strBody = "@owner=" & Item.UserProperties("ticketowner") & vbCrLf & "@submitter=" & Item.UserProperties("ticketsubmiter") & vbCrLf & "@status=" & Item.UserProperties("ticketstatus") & vbCrLf & "@impact=" & Item.UserProperties("ticketseverity") & vbCrLf & vbCrLf & "@priority=" & Item.UserProperties("ticketpriority") & vbCrLf & "@category=" & Item.UserProperties("ticketcategory") & vbCrLf & "@location=" & Item.UserProperties("ticketlocation") & vbCrLf & "@company=" & Item.UserProperties("ticketcompany") & vbCrLf & Item.Body
    Else
    strBody = "@owner=" & Item.UserProperties("ticketowner") & vbCrLf & "@submitter=" & Item.UserProperties("ticketsubmiter") & vbCrLf & "@cc_list=" & Item.CC & vbCrLf & "@status=" & Item.UserProperties("ticketstatus") & vbCrLf & "@impact=" & Item.UserProperties("ticketseverity") & vbCrLf & vbCrLf & "@priority=" & Item.UserProperties("ticketpriority") & vbCrLf & "@category=" & Item.UserProperties("ticketcategory") & vbCrLf & "@location=" & Item.UserProperties("ticketlocation") & vbCrLf & "@company=" & Item.UserProperties("ticketcompany") & vbCrLf & Item.Body
    End If
Else
        If ConAsset.Value = "" Then
            If Item.CC = "" Then
            strBody = "@owner=" & Item.UserProperties("ticketowner") & vbCrLf & "@submitter=" & Item.UserProperties("ticketsubmiter") & vbCrLf & "@status=" & Item.UserProperties("ticketstatus") & vbCrLf & "@impact=" & Item.UserProperties("ticketseverity") & vbCrLf & vbCrLf & "@priority=" & Item.UserProperties("ticketpriority") & vbCrLf & "@machine=" & Item.UserProperties("ticketmachine") & vbCrLf & "@category=" & Item.UserProperties("ticketcategory") & vbCrLf & "@location=" & Item.UserProperties("ticketlocation") & vbCrLf & "@company=" & Item.UserProperties("ticketcompany") & vbCrLf & Item.Body
            Else
            strBody = "@owner=" & Item.UserProperties("ticketowner") & vbCrLf & "@submitter=" & Item.UserProperties("ticketsubmiter") & vbCrLf & "@cc_list=" & Item.CC & vbCrLf & "@status=" & Item.UserProperties("ticketstatus") & vbCrLf & "@impact=" & Item.UserProperties("ticketseverity") & vbCrLf & vbCrLf & "@priority=" & Item.UserProperties("ticketpriority") & vbCrLf & "@machine=" & Item.UserProperties("ticketmachine") & vbCrLf & "@category=" & Item.UserProperties("ticketcategory") & vbCrLf & "@location=" & Item.UserProperties("ticketlocation") & vbCrLf & "@company=" & Item.UserProperties("ticketcompany") & vbCrLf & Item.Body
            End If
        Else
            If ConMachine.Value = "" Then
                If Item.CC = "" Then
                strBody = "@owner=" & Item.UserProperties("ticketowner") & vbCrLf & "@submitter=" & Item.UserProperties("ticketsubmiter") & vbCrLf & "@status=" & Item.UserProperties("ticketstatus") & vbCrLf & "@impact=" & Item.UserProperties("ticketseverity") & vbCrLf & vbCrLf & "@priority=" & Item.UserProperties("ticketpriority") & vbCrLf & "@asset=" & Item.UserProperties("ticketasset") & vbCrLf & "@category=" & Item.UserProperties("ticketcategory") & vbCrLf & "@location=" & Item.UserProperties("ticketlocation") & vbCrLf & "@company=" & Item.UserProperties("ticketcompany") & vbCrLf & Item.Body
                Else
                strBody = "@owner=" & Item.UserProperties("ticketowner") & vbCrLf & "@submitter=" & Item.UserProperties("ticketsubmiter") & vbCrLf & "@cc_list=" & Item.CC & vbCrLf & "@status=" & Item.UserProperties("ticketstatus") & vbCrLf & "@impact=" & Item.UserProperties("ticketseverity") & vbCrLf & vbCrLf & "@priority=" & Item.UserProperties("ticketpriority") & vbCrLf & "@asset=" & Item.UserProperties("ticketasset") & vbCrLf & "@category=" & Item.UserProperties("ticketcategory") & vbCrLf & "@location=" & Item.UserProperties("ticketlocation") & vbCrLf & "@company=" & Item.UserProperties("ticketcompany") & vbCrLf & Item.Body
                End If
            Else
                If Item.CC = "" Then
                strBody = "@owner=" & Item.UserProperties("ticketowner") & vbCrLf & "@submitter=" & Item.UserProperties("ticketsubmiter") & vbCrLf & "@status=" & Item.UserProperties("ticketstatus") & vbCrLf & "@impact=" & Item.UserProperties("ticketseverity") & vbCrLf & vbCrLf & "@priority=" & Item.UserProperties("ticketpriority") & vbCrLf & "@asset=" & Item.UserProperties("ticketasset") & vbCrLf & "@machine=" & Item.UserProperties("ticketmachine") & vbCrLf & "@category=" & Item.UserProperties("ticketcategory") & vbCrLf & "@location=" & Item.UserProperties("ticketlocation") & vbCrLf & "@company=" & Item.UserProperties("ticketcompany") & vbCrLf & Item.Body
                Else
                strBody = "@owner=" & Item.UserProperties("ticketowner") & vbCrLf & "@submitter=" & Item.UserProperties("ticketsubmiter") & vbCrLf & "@cc_list=" & Item.CC & vbCrLf & "@status=" & Item.UserProperties("ticketstatus") & vbCrLf & "@impact=" & Item.UserProperties("ticketseverity") & vbCrLf & vbCrLf & "@priority=" & Item.UserProperties("ticketpriority") & vbCrLf & "@asset=" & Item.UserProperties("ticketasset") & vbCrLf & "@machine=" & Item.UserProperties("ticketmachine") & vbCrLf & "@category=" & Item.UserProperties("ticketcategory") & vbCrLf & "@location=" & Item.UserProperties("ticketlocation") & vbCrLf & "@company=" & Item.UserProperties("ticketcompany") & vbCrLf & Item.Body
                End If
            End If
        End If
End If

Item.CC = ""

Set NewMail = Application.CreateItem(0)
NewMail.BodyFormat = olFormatPlain

' transfer subject
NewMail.Subject = Item.Subject

' transfer recipients
For Each objRecip in Item.Recipients
NewMail.Recipients.Add objRecip.Address
Next


NewMail.Body = strBody

' send it
NewMail.Send

' discard the original
Item_Send = False
Set insp = Item.GetInspector
insp.Close olDiscard

End Function

Function Item_Open()
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set ConSubmitter = frmMsg.controls("txtSubmitter")
Set ConAsset = frmMsg.controls("txtAsset")
Set ConMachine = frmMsg.controls("txtMachine")
Set ConOwner = frmMsg.controls("txtOwner")
Set ConLocation = frmMsg.controls("txtLocation")
Set ConCompany = frmMsg.controls("txtCompany")
 
ConOwner.Value = Application.GetNameSpace("MAPI").CurrentUser
Get_Categories
Get_Statuses
Get_Priorities
Get_Severities
Get_Owners
Get_Locations
Get_Companies
Item.CC = Get_Email_CC
Item.Body = Get_Email_Body
Get_Email_Sender
Item.Subject = Get_Email_Sender_FullName & " - " & Get_Email_Subject & " - "
If ConSubmitter.Value = "" Then
   ConAsset.Enabled = False
   ConMachine.Enabled = False
Else
   ConAsset.Enabled = True
   ConMachine.Enabled = True
End If

Get_Location

Item.Subject = Get_Email_Sender_FullName & " - " & Get_Email_Subject & " - " & ConLocation.Value

End Function

Function Get_Owners
dim oConn
dim query                  ' Query
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set Control = frmMsg.controls("txtOwner")

' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query
Control.AddItem ""
set rs = oConn.Execute("SELECT FULL_NAME FROM USER WHERE ROLE_ID = 1 AND USER_NAME <> 'admin' ORDER BY FULL_NAME;")
Do While Not rs.EOF
    For i=0 to num_fields
        myItemtoAdd = rs.fields.Item(i)
        Control.AddItem myItemtoAdd
        rs.movenext
    next
Loop

rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing

End Function

Function Get_Tickets
dim oConn
dim query                  ' Query
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set Control = frmMsg.controls("txtTickID")

' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query

NumItems = (Control.ListCount - 1)

For i = (NumItems) To 0 Step -1
Control.RemoveItem (i)
next
set rs = oConn.Execute("SELECT ID, TITLE FROM HD_TICKET WHERE HD_STATUS_ID <> 2 ORDER BY TITLE;")

fields=rs.GetRows
arrCount = uBound(fields, 2)

    For i=0 to arrCount
    control.additem fields(0,i)
    control.list(i,1) = fields(1,i)
    next



rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing
End Function


Function Get_Categories
dim oConn
dim query                  ' Query
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set Control = frmMsg.controls("txtcategory")

' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query
set rs = oConn.Execute("SELECT NAME FROM HD_CATEGORY ORDER BY NAME;")
Do While Not rs.EOF
    For i=0 to num_fields
        myItemtoAdd = rs.fields.Item(i)
        Control.AddItem myItemtoAdd
        rs.movenext
    next
Loop

rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing
End Function

Function Get_Statuses
dim oConn
dim query                  ' Query
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set Control = frmMsg.controls("txtStatus")

' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query
set rs = oConn.Execute("SELECT NAME FROM HD_STATUS;")
Do While Not rs.EOF
    For i=0 to num_fields
        myItemtoAdd = rs.fields.Item(i)
        Control.AddItem myItemtoAdd
        rs.movenext
    next
Loop

rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing
End Function

Function Get_Priorities
dim oConn
dim query                  ' Query
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set Control = frmMsg.controls("priority")

' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query
set rs = oConn.Execute("SELECT NAME FROM HD_PRIORITY;")
Do While Not rs.EOF
    For i=0 to num_fields
        myItemtoAdd = rs.fields.Item(i)
        Control.AddItem myItemtoAdd
        rs.movenext
    next
Loop

rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing
End Function

Function Get_Companies
dim oConn
dim query                  ' Query
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set Control = frmMsg.controls("txtCompany")

' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query
set rs = oConn.Execute("SELECT HD_CUSTOM_FIELDS.VALUES FROM HD_CUSTOM_FIELDS WHERE NAME = 'CUSTOM_2';")
Control.PossibleValues = rs.fields.Item(0)
rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing
End Function


Function Get_Locations
dim oConn
dim query                  ' Query
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set Control = frmMsg.controls("txtLocation")

' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query
set rs = oConn.Execute("SELECT HD_CUSTOM_FIELDS.VALUES FROM HD_CUSTOM_FIELDS WHERE NAME = 'CUSTOM_1';")
Control.PossibleValues = rs.fields.Item(0)
rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing
End Function



Function Get_Severities
dim oConn
dim query                  ' Query
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set Control = frmMsg.controls("txtSeverity")

' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query
set rs = oConn.Execute("SELECT NAME FROM HD_IMPACT;")
Do While Not rs.EOF
    For i=0 to num_fields
        myItemtoAdd = rs.fields.Item(i)
        Control.AddItem Trim(cStr(myItemtoAdd))
        rs.movenext
    next
Loop

rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing
End Function


Sub Item_CustomPropertyChange(ByVal Name)
    Select Case Name
        Case "ticketsubmiter"
            Set oConn = CreateObject("ADODB.Connection")
            oConn.Open "DSN=MySQL"

            Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
            Set ConSubmitter = frmMsg.controls("txtSubmitter")
            Set ConAsset = frmMsg.controls("txtAsset")
            Set ConMachine = frmMsg.controls("txtMachine")
            set rs = oConn.Execute("SELECT USER_NAME FROM ORG1.USER WHERE USER_NAME = '" & ConSubmitter.Value & "';")
            If rs.EOF Then
                set rs = oConn.Execute("SELECT USER_NAME FROM ORG1.USER WHERE USER_NAME LIKE '%" & ConSubmitter.Value & "%';")
                If rs.EOF Then
                    MsgBox "User: " & dsSubmitter & " Not Found Please Check Spelling"
                Else
                    NumItems = (ConSubmitter.ListCount - 1)

                    For i = (NumItems) To 0 Step -1
                        ConSubmitter.RemoveItem (i)
                    next


                    Do While Not rs.EOF
                        For i=0 to num_fields
                            myItemtoAdd = rs.fields.Item(i)
                            ConSubmitter.AddItem myItemtoAdd
                            rs.movenext
                        next
                    Loop

                End If
            Else

                If ConSubmitter.Value = "" Then
                    msgbox "Please Enter an User Name"
                Else
                    Get_Location
                    Get_Machine_Names(ConSubmitter.Value)
                    
                End If
            End If
        Case "ticketmachine"
            Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
            Set ConSubmitter = frmMsg.controls("txtSubmitter")
            Set ConAsset = frmMsg.controls("txtAsset")
            Set ConMachine = frmMsg.controls("txtMachine")
            Dim mID    
                If ConSubmitter.Value = "" or ConMachine.Value = "" Then
                    msgbox "Please Enter an User Name and Select a Machine"
                Else
                      mID = Get_Machine_IDs(ConMachine.Value)
                    Get_Assets(mID)
                End If
        Case "ticketcategory"
            Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
            Set ConOwner = frmMsg.controls("txtOwner")
            Set ConCategory = frmMsg.controls("txtCategory")
            Set ConUpdate = frmMsg.controls("cbxUpdate")
            If ConUpdate = True Then
            Else
                If ConCategory = "Other" or ConCategory = "Project A" or ConCategory = "Project B" or ConCategory = "Project C" or ConCategory = "Project D" Then
                
                Else
                    Set oConn = CreateObject("ADODB.Connection")
                    oConn.Open "DSN=MySQL"
                    ' Execute query
                    set rs = oConn.Execute("SELECT FULL_NAME FROM ORG1.USER INNER JOIN HD_CATEGORY ON USER.ID = HD_CATEGORY.DEFAULT_OWNER_ID WHERE NAME = '" & ConCategory.Value & "';")
                    myItemtoAdd = rs.fields.Item(0)
                    ConOwner.Value = myItemtoAdd
                    rs.close
                    set rs = Nothing
                    oConn.Close
                    set oConn = Nothing
                End If
             End If
        Case "ticketupdate"
            Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
            Set ConTicket = frmMsg.controls("cbxUpdate")
            Set ConTickID = frmMsg.controls("txtTickID")
            Set ConSubject = frmMsg.controls("txtSubject")
            Set ConSubmitter = frmMsg.controls("txtSubmitter")
            Set ConAsset = frmMsg.controls("txtAsset")
            Set ConMachine = frmMsg.controls("txtMachine")
            Set ConOwner = frmMsg.controls("txtOwner")
            Set ConCategory = frmMsg.controls("txtCategory")
            Set ConStatus = frmMsg.controls("txtStatus")
            Set ConPriority = frmMsg.controls("priority")
            Set ConSeverity = frmMsg.controls("txtSeverity")


            NumItems = (ConTickID.ListCount - 1)
            If ConTicket = True Then
                ConTickID.Enabled = True
                ConTickID.Visible = True
                Get_Tickets
            Else
                ConTickID.Enabled = False
                ConTickID.Visible = False
                Item.CC = ""
                ConSubject.Value = ""
                ConSubmitter.Value = ""
                ConAsset.Value = ""
                ConAsset.Enabled = False
                ConMachine.Value = ""
                ConMachine.Enabled = False
                ConOwner.Value = Application.GetNameSpace("MAPI").CurrentUser
                ConCategory.Value = ""
                ConStatus.Value = "Opened"
                ConPriority.Value = "Low"
                ConSeverity.Value = "Low - 1 to 2 people effected - They Can Still Work"

                For i = (NumItems) To 0 Step -1
                    ConTickID.RemoveItem (i)
                next

            End If
        Case "ticketID"
            
            Set oConn = CreateObject("ADODB.Connection")
            oConn.Open "DSN=MySQL"
            Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
            Set ConSubmitter = frmMsg.controls("txtSubmitter")
            Set ConAsset = frmMsg.controls("txtAsset")
            Set ConMachine = frmMsg.controls("txtMachine")
            Set ConOwner = frmMsg.controls("txtOwner")
            Set ConCategory = frmMsg.controls("txtCategory")
            Set ConStatus = frmMsg.controls("txtStatus")
            Set ConPriority = frmMsg.controls("priority")
            Set ConSeverity = frmMsg.controls("txtSeverity")
            Set ConUpdate = frmMsg.controls("cbxUpdate")
            Set ConSubject = frmMsg.controls("txtSubject")
            Set ConLocation = frmMsg.controls("txtLocation")
            Set ConCompany = frmMsg.controls("txtCompany")
            Set ConID = frmMsg.controls("txtTickID")
            
                If ConUpdate = True Then
                    ConSubject.Value = "[TICK:" & ConID.Column(0) & "] " & ConID.Column(1)
                    
                    set rsSubmitter = oConn.Execute("SELECT USER_NAME FROM ORG1.USER INNER JOIN HD_TICKET ON USER.ID = HD_TICKET.SUBMITTER_ID WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    dsSubmitter = rsSubmitter.fields.Item(0)
                    ConSubmitter.Value = dsSubmitter
                                        
                    set rsLocation = oConn.Execute("SELECT CUSTOM_FIELD_VALUE0 FROM HD_TICKET WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    If rsLocation.EOF Then
                    ConLocation .Value = ""    
                    Else
                    dsLocation = rsLocation.fields.Item(0)
                    ConLocation.Value = dsLocation
                    End If

                    set rsCompany = oConn.Execute("SELECT CUSTOM_FIELD_VALUE1 FROM HD_TICKET WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    If rsCompany.EOF Then
                    ConCompany .Value = ""    
                    Else
                    dsCompany = rsCompany.fields.Item(0)
                    ConCompany.Value = dsCompany
                    End If


                    set rsMachine = oConn.Execute("SELECT NAME FROM ORG1.MACHINE INNER JOIN HD_TICKET ON MACHINE.ID = HD_TICKET.MACHINE_ID WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    If rsMachine.EOF Then
                    ConMachine.Value = ""
                    Else
                    dsMachine = rsMachine.fields.Item(0)
                    ConMachine.Enabled = True
                    ConMachine.Value = dsMachine
                    End If

                    set rsOwner = oConn.Execute("SELECT FULL_NAME FROM ORG1.USER INNER JOIN HD_TICKET ON USER.ID = HD_TICKET.OWNER_ID WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    dsOwner = rsOwner.fields.Item(0)
                    ConOwner.Value = dsOwner
                    set rsCategory = oConn.Execute("SELECT NAME FROM ORG1.HD_CATEGORY INNER JOIN HD_TICKET ON HD_CATEGORY.ID = HD_TICKET.HD_CATEGORY_ID WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    If rsCategory.EOF Then
                    ConCategory.Value = ""
                    Else
                    dsCategory = rsCategory.fields.Item(0)
                    ConCategory.Value = dsCategory
                    End If    
                    set rsStatus = oConn.Execute("SELECT NAME FROM ORG1.HD_STATUS INNER JOIN HD_TICKET ON HD_STATUS.ID = HD_TICKET.HD_STATUS_ID WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    dsStatus = rsStatus.fields.Item(0)
                    ConStatus.Value = dsStatus
                    set rsPriority = oConn.Execute("SELECT NAME FROM ORG1.HD_PRIORITY INNER JOIN HD_TICKET ON HD_PRIORITY.ID = HD_TICKET.HD_PRIORITY_ID WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    dsPriority = rsPriority.fields.Item(0)
                    ConPriority.Value = dsPriority
                    set rsSeverity = oConn.Execute("SELECT NAME FROM ORG1.HD_IMPACT INNER JOIN HD_TICKET ON HD_IMPACT.ID = HD_TICKET.HD_IMPACT_ID WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    dsSeverity = rsSeverity.fields.Item(0)
                    ConSeverity.Value = dsSeverity
                    
                    set rsCC = oConn.Execute("SELECT CC_LIST FROM ORG1.HD_TICKET WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    dsCC = rsCC.fields.Item(0)
                    Item.CC = dsCC

                    
                    set rsAsset = oConn.Execute("SELECT NAME FROM ORG1.ASSET INNER JOIN HD_TICKET ON ASSET.ID = HD_TICKET.ASSET_ID WHERE HD_TICKET.ID = '" & ConID.Column(0)& "';")
                    If rsAsset.EOF Then
                    ConAsset.Value = ""    
                    Else
                    dsAsset = rsAsset.fields.Item(0)
                    ConAsset.Enabled = True
                    ConAsset.Value = dsAsset
                    End If

                    rsSubmitter.close
                    set rsSubmitter = Nothing
                    rsAsset.close
                    set rsAsset= Nothing
                    rsMachine.close
                    set rsMachine = Nothing
                      rsOwner.close
                    set rsOwner = Nothing
                    rsCategory.close
                    set rsCategory = Nothing
                    rsStatus.close
                    set rsStatus = Nothing
                    rsPriority.close
                    set rsPriority = Nothing
                    rsSeverity.close
                    set rsSeverity = Nothing
                    rsCC.close
                    set rsCC = Nothing


                    oConn.Close
                    set oConn = Nothing

                Else

                    
                End If
            
    End Select
    
End Sub


Function Get_Machine_Names(uName)
dim oConn
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set Control = frmMsg.controls("txtMachine")
Set Control1 = frmMsg.controls("txtAsset")
Set Control2 = frmMsg.controls("cbxUpdate")

Control.Enabled = True
' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query
set rs = oConn.Execute("SELECT NAME FROM MACHINE WHERE USER = '" & uName & "';")

If Control.Enabled = True Then
Else
Control.Value = ""
Control1.Value = ""
End If

NumItems = (Control.ListCount - 1)

For i = (NumItems) To 0 Step -1
Control.RemoveItem (i)
next


Do While Not rs.EOF
    For i=0 to num_fields
        myItemtoAdd = rs.fields.Item(i)
        Control.AddItem myItemtoAdd
        rs.movenext
    next
Loop


rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing
End Function

Function Get_Machine_IDs(uName)
dim oConn
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query
set rs = oConn.Execute("SELECT ID FROM MACHINE WHERE NAME = '" & uName & "';")

machineID = rs.fields.Item(0)
        
rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing
Get_Machine_IDs = machineID
End Function
 
Function Get_Assets(mID)
dim oConn
dim rs                          ' Result set
dim num_fields          ' Fields in result set
dim i
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set Control = frmMsg.controls("txtAsset")
Control.Enabled = True
' Connect to server
Set oConn = CreateObject("ADODB.Connection")
oConn.Open "DSN=MySQL"
' Execute query
set rs = oConn.Execute("SELECT Name FROM ASSET WHERE MAPPED_ID = " & mID & ";")

NumItems = (Control.ListCount - 1)

For i = (NumItems) To 0 Step -1
Control.RemoveItem (i)
next

Do While Not rs.EOF
    For i=0 to num_fields
        myItemtoAdd = rs.fields.Item(i)
        Control.AddItem myItemtoAdd
        rs.movenext
    next
Loop

rs.close
set rs = Nothing
oConn.Close
set oConn = Nothing

End Function

Function Get_Location
Set frmMsg = Item.GetInspector.ModifiedFormPages("Message")
Set ConCompany = frmMsg.controls("txtCompany")
Set ConLocation = frmMsg.controls("txtLocation")
Set ConSubmitter = frmMsg.controls("txtSubmitter")
If Consubmitter.Value = "" Then
Else
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strTarget = "LDAP://" & strDNSDomain
' Connect to Ad Provider
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCmd = CreateObject("ADODB.Command")
Set objCmd.ActiveConnection = objConnection
objCmd.CommandText = "SELECT physicalDeliveryOfficeName FROM '" & strTarget & "' WHERE objectCategory = 'user' and sAMAccountName = '"& ConSubmitter.Value &"'"
Const ADS_SCOPE_SUBTREE = 2
objCmd.Properties("Page Size") = 100
objCmd.Properties("Timeout") = 30
objCmd.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCmd.Properties("Cache Results") = False
Set objRecordSet = objCmd.Execute
ConLocation.Value = objRecordSet.fields.Item(0)
If objRecordSet.fields.Item(0) = "Corporate" Then
     ConCompany.Value = "99"
Else
    If Instr(objRecordSet.fields.Item(0), "AT ") <> 0 Then
         ConCompany.Value = "80"
    Else
     ConCompany.Value = "10"
    End If
End If
End If
End Function    
   


    
   


Comments

This post is locked
 
This website uses cookies. By continuing to use this site and/or clicking the "Accept" button you are providing consent Quest Software and its affiliates do NOT sell the Personal Data you provide to us either when you register on our websites or when you do business with us. For more information about our Privacy Policy and our data protection efforts, please visit GDPR-HQ