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