[rt-users] Need help getting REST API calls to work using WinHttpRequest from VBA

[tim]

By using the following code placed into a class called clsRT_Ticket I was
able to create RT Tickets within VBA successfully.  Hope this helps others
that have run into this issue with VBA.

'Must Include Microsoft WinHTTP Services, version 5 (winhttp.dll) in your
reference

'NOTE: to call CreateTicket function from code
'Set RT_Ticket = New clsRT_Ticket
'With RT_Ticket
'    .ProcessBar = Me.StatusBar
'    .DisplayTicketInfoUponCreation = True
'    .Body = sbody
'    .PIDs = cPIDs
'    .BankID_Old = sOrgReturnedCheck_BankID
'    .BankID_New = ReturnedCheck.BankId
'    .CreateTicket
'End With
'Set RT_Ticket = Nothing

Private WinHttpReq As WinHttpRequest

Private Const multiPartBoundary As String = "--xYzZY"

Private mvarRT_URL As String
Private mvarRT_CreateTICKET As String
Private mvarRT_ShowTICKET As String
Private mvarRT_Auth_User As String
Private mvarRT_Auth_PWD As String

Private mvarSessionCookie As String
Private mvarCookieHolder As Variant

Private mvarBody As String
Private mvarRequestor As String
Private mvarSubject As String
Private mvarTicketNumber As String
'

Private Sub Class_Initialize()
    'create the WinHttpRequest object
    Set WinHttpReq = New WinHttpRequest

    mvarRT_URL = "https://(RT server):#####"  'where ##### points to a valid
port if needed
    mvarRT_CreateTICKET = mvarRT_URL & "/REST/1.0/ticket/new"
    mvarRT_ShowTICKET = mvarRT_URL & "/REST/1.0/ticket/%ticket%/SHOW"
    mvarRT_Auth_User = "(valid RT user name)"
    mvarRT_Auth_PWD = "(valid RT user password)"
    mvarRequestor = "(valid RT requestor name)"
        
    mvarBody = ""
    mvarSubject = ""
    mvarTicketNumber = ""
    
End Sub

Private Sub Class_Terminate()
    Set WinHttpReq = Nothing

End Sub

Public Function CreateTicket() As Boolean
    Dim sMultiPartData As String
    Dim sCustomFieldValue As String     'value to be placed into custom
field if used
    
    mvarBody = "text to be displayed in body of "
    mvarSubject = ""
    
    'setup multipart/form-data to be passed to RT request
    sMultiPartData = ""
    sMultiPartData = multiPartBoundary & vbCrLf
    sMultiPartData = sMultiPartData + "Content-Disposition: form-data;
name=""content""" + vbCrLf + vbCrLf
    sMultiPartData = sMultiPartData + "id: ticket/new" + vbCrLf
    sMultiPartData = sMultiPartData + "Subject: " + mvarSubject + vbCrLf
    sMultiPartData = sMultiPartData + "Text: " + mvarBody + vbCrLf
    sMultiPartData = sMultiPartData + "Requestor: " & mvarRequestor & vbCrLf
    
    'had to include next statement twice to get custom field values to be
accepted in RT
    sMultiPartData = sMultiPartData + "CF-(name of custom field): " +
sCustomFieldValue + vbCrLf
    sMultiPartData = sMultiPartData + "CF-(name of custom field): " +
sCustomFieldValue + vbCrLf
    
    sMultiPartData = sMultiPartData + "Queue: General" + vbCrLf
    sMultiPartData = sMultiPartData + "--xYzZY--"

    With WinHttpReq
        If getValidSessionCookie Then   'get cookie from first call to RT
            'Debug.Print .ResponseText
            
            '2) create New RT ticket
            .Open "POST", mvarRT_CreateTICKET
            .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1;
WOW64; rv:38.0) Gecko/20100101 Firefox/38.0"
            .setRequestHeader "Accept",
"text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
            .setRequestHeader "Accept-Language", "en-US,en;q=0.5"
            .setRequestHeader "DNT", "1"
            .setRequestHeader "Referer", mvarRT_CreateTICKET
            .setRequestHeader "Cookie", mvarSessionCookie
            .setRequestHeader "Connection", "keep-alive"
            .setRequestHeader "Content-Type", "multipart/form-data;
boundary=xYzZY"
            .setRequestHeader "Content-Length", CStr(Len(sMultiPartData))
            .send (sMultiPartData)

            If .Status = 200 Then
                mvarTicketNumber = Trim(.responseText)
                If InStr(mvarTicketNumber, "401 Credentials required") < 1
Then
                    'get RT ticket number
                    mvarTicketNumber = Replace(mvarTicketNumber, Chr(10),
"")
                    If mvarTicketNumber <> "" Then
                        'return just the RT ticket number
                        mvarTicketNumber = Mid(mvarTicketNumber,
InStr(mvarTicketNumber, "# Ticket ") + Len("# Ticket "))
                        mvarTicketNumber = Replace(mvarTicketNumber, "
created.", "")
                    End If
                
                    Debug.Print "RT Ticket #" & CStr(mvarTicketNumber) & "
created."
                Else
                    Debug.Print .responseText
                    Debug.Print .getAllResponseHeaders
                End If
            Else
                Debug.Print .responseText
                Debug.Print .getAllResponseHeaders
            End If
        Else
            'cannot establish a connection to RT server, so try again up to
3 attempts only
            Debug.Print .responseText
            Debu8g.Print .getAllResponseHeaders
        End If
        
    End With
    
End Function

Public Function ShowTicket(ByVal sTicketNumber As String) As Boolean
    
    If getValidSessionCookie Then   'get initial request and cookie to pass
to RT request
        '3) show RT ticket information returned
        With WinHttpReq
            .Open "GET", Replace(mvarRT_ShowTICKET, "%ticket%",
sTicketNumber)
            .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1;
WOW64; rv:38.0) Gecko/20100101 Firefox/38.0"
            .setRequestHeader "Accept",
"text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
            .setRequestHeader "Accept-Language", "en-US,en;q=0.5"
            .setRequestHeader "DNT", "1"
            .setRequestHeader "Cookie", mvarSessionCookie
            .setRequestHeader "Connection", "keep-alive"
            .send
    
            If .Status = 200 Then
                Debug.Print .responseText
            End If
        End With
    End If
    
End Function

Private Function getValidSessionCookie() As Boolean
    Dim sMsg As String
    
    With WinHttpReq
            
        .Option(4) = 13056  'WinHttpRequestOption_SslErrorIgnoreFlags 13056:
ignore all err,
        
        '1) get cookie to reuse (DO NOT CHANGE!!!)
        .Open "POST", mvarRT_URL
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64;
rv:38.0) Gecko/20100101 Firefox/38.0"
        .setRequestHeader "Accept",
"text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
        .setRequestHeader "Accept-Language", "en-US,en;q=0.5"
        .setRequestHeader "DNT", "1"
        .setRequestHeader "Connection", "keep-alive"
        .setRequestHeader "Content-Type",
"application/x-www-form-urlencoded"
        .setRequestHeader "Content-Length", Len("user=" & mvarRT_Auth_User &
"&pass=" & mvarRT_Auth_PWD)
        .send ("user=" & mvarRT_Auth_User & "&pass=" & mvarRT_Auth_PWD)
        
        If .Status = 200 Then
            mvarSessionCookie = .getResponseHeader("Set-Cookie")

            mvarCookieHolder = Split(mvarSessionCookie, ";")
            If UBound(mvarCookieHolder) > 0 Then
                'implicit conversion to string
                mvarSessionCookie = mvarCookieHolder(0)
            End If
        End If
        
    End With
    
End Function




--
View this message in context: http://requesttracker.8502.n7.nabble.com/Need-help-getting-REST-API-calls-to-work-using-WinHttpRequest-from-VBA-tp59981p61745.html
Sent from the Request Tracker - User mailing list archive at Nabble.com.