I have a macro that I run with Outlook to create a ticket for certain emails through Rest API Post and I read the result with GET, the first time it works fine, but the second time it sends me the error of "403 - Invalid CSRF token" null "Was found on the request parameter" _csrf "or header X-CSRF-TOKEN", could you please help me to know what it is and how to solve the problem? This is the code:
Option Explicit
Private WithEvents inboxItems As Outlook.Items
Private Const xlUp As Long = -4162
Dim PosIni As Integer, EmpID As String, FechaB As String, TextBody As String, RequestD As String
Dim Request As String, SenderN As String, VEmp As String, EmpName As String, Usr As String
Dim objRequest As Object
Dim strUrl As String, vticket As String, finalRow As Integer, nfecha As String, nTime As Date, espera As Integer
Dim blnAsync As Boolean, Rcode As Long, ncont As Integer, i As Integer, horaactual As Date
Dim strResponse As String * 7000, RespTicket As String, sDayName As String, areatick As String
Dim Body As String, rstatusr As String, rstatus As String, rStsType As String, rStsName, rticket As String
Dim xlApp As Object ' Excel.Application
Dim xlBook As Object ' Excel.Workbook
Dim xlSheet As Object ' Excel.Worksheet
Dim fileDoesExist As Boolean
Dim sFileName As String
Dim rCount As Long
Private Sub Application_Startup()
Dim outlookApp As Outlook.Application
Dim objectNS As Outlook.NameSpace
Set outlookApp = Outlook.Application
Set objectNS = outlookApp.GetNamespace("MAPI")
Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
nfecha = Date
nTime = Time()
rstatus = ""
' Validate if the incoming mail meets the conditions to trigger the ticket creation
If TypeName(Item) = "MailItem" Then
' Validate if the SenderName and the Subject correspond to the desired search
'If Item.SenderName = "CRUZ VEGA, NORMA ARACELI" Then
If Item.SenderName = "Procesos Automáticos SAP BASIS_JOBS" Or Item.SenderName = "Centro de Atencion a Cuentas" Then
PosIni = InStr(Item.Subject, "Baja de empleado en el ADS.")
If PosIni > 0 Then
' Extract the information from the email to generate the information for the ticket creation
Request = Mid(Item.Subject, PosIni, 27)
TextBody = Mid(Item.Body, 1, 2000)
PosIni = InStr(TextBody, "su usuario") + 11
Usr = Mid(TextBody, PosIni, 12)
PosIni = InStr(TextBody, "Favor")
RequestD = Mid(TextBody, PosIni, 90)
PosIni = InStr(TextBody, "El empleado") + 12
VEmp = Mid(TextBody, PosIni, 50)
EmpID = Split(VEmp, "-")(0)
EmpName = Split(VEmp, "-")(1)
PosIni = InStr(TextBody, "con fecha") + 10
FechaB = Mid(TextBody, PosIni, 8)
areatick = "MIS.INT.MX.CCO.VITRO"
'Configure the information for the ticket and the body for the API connection and send the ticket creation request (post)
vticket = "{*|*GeneralTitle*|*:*|*VITRO MX | USER MANAGEMENT | CCO | ACTIVE DIRECTORY BAJA DE USUARIO| Prueba SD*|*,*|*GeneralCustomer*|*:*|*VIDRIERA MONTERREY S.A. DE C.V/VIDRIERA MONTERREY S.A. DE C.V*|*,*|*GeneralCategory1*|*:*|*SERVICE REQUEST*|*,*|*GeneralCategory2*|*:*|*ACCESS*|*,*|*GeneralCategory3*|*:*|*OTHER*|*,*|*GeneralCategory4*|*:*|*NSLA INFR1 P5*|*,*|*GeneralAssignmentGroup*|*:*|*MIS.INT.MX.CCO.VITRO*|*,*|*PrioritizationCriticality*|*:*|*NONE*|*,*|*PrioritizationServiceRestriction*|*:*|*NONE*|*,*|*PrioritizationPriority*|*:*|*5*|*,*|*CausingCIName*|*:*|*CI_TBD*|*,*|*Description*|*:*|*Nombre Completo:" & EmpName & "<salto> UID:" & EmpID & "<salto> Usr:" & Usr & "<salto> Fecha de Baja:" & FechaB & "*|*,*|*LocationName*|*:*|*VITRO_MX_NVO-LEON_ROBLE-660*|*,*|*CauseCode*|*:*|*BG293314*|*}"
Body = "{""uuid"": ""f91c08a1-0d04-48b0-8136-e76e49bdfc96"", ""runName"": ""MytestsChatbot"", ""logLevel"": ""DEBUG"", ""inputs"": {""user"": ""INCIDENT-CHATBOT"", ""passw"": ""IQAuAEMAaABhAHQAQgAwADEANABQAFAAQQBjAGMAZQBzAHMA"", ""funct"": ""CreateIncident"",""json"":" & Chr(34) & vticket & Chr(34) & "}}"
' Make the API connection to perform the ticket creation requirement
Set objRequest = CreateObject("MSXML2.XMLHTTP")
strUrl = "http://160.118.117.80:8080/oo/rest/executions"
With objRequest
.Open "POST", strUrl, False
.SetRequestHeader "Authorization", "Basic SU5DSURFTlQtSFBPTy1NWDrCoUNyM2F0ZVRpY2szdCEhLg=="
.SetRequestHeader "Content-Type", "application/json"
.Send Body
While objRequest.readyState <> 4
DoEvents
Wend
strResponse = .ResponseText
End With
PosIni = InStr(strResponse, "executionId") + 14
Rcode = Mid(strResponse, PosIni, 9)
Debug.Print strResponse
' Calls the status verification routine of the ticket creation process (Get)
rstatusr = "RUNNING"
While rstatusr = "RUNNING"
For i = 1 To 2000
ncont = i
Next i
Call GetSts
Wend
Item.Subject = rticket & " - " & Item.Subject
Item.Save
' Call the routine to save in the historical file, the information of the ticket created
Call GrabaXls
End If
End If
End If
ExitNewItem:
Set objRequest = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ExitNewItem
End Sub
Sub GetSts()
'Make the API connection to check the ticket creation status (get)
strUrl = "http://160.118.117.80:8080/oo/rest/executions/" & Rcode & "/execution-log"
blnAsync = True
With objRequest
.Open "GET -H", strUrl, blnAsync
.SetRequestHeader "Authorization", "Basic SU5DSURFTlQtSFBPTy1NWDrCoUNyM2F0ZVRpY2szdCEhLg=="
.Send
While objRequest.readyState <> 4
DoEvents
Wend
strResponse = .ResponseText
PosIni = InStr(.ResponseText, "newTicket")
rticket = Mid(.ResponseText, PosIni + 12, 12)
PosIni = InStr(strResponse, "status")
rstatusr = Mid(strResponse, PosIni + 9, 7)
rstatus = Mid(strResponse, PosIni + 9, 9)
Debug.Print strResponse
strResponse = Mid(.ResponseText, 100, 100)
PosIni = InStr(strResponse, "status")
rstatus = Mid(strResponse, PosIni + 9, 9)
PosIni = InStr(strResponse, "StatusType")
rStsType = Mid(strResponse, PosIni + 13, 8)
PosIni = InStr(strResponse, "StatusName")
rStsName = Mid(strResponse, PosIni + 13, 7)
End With
Set objRequest = Nothing
End Sub
Sub GrabaXls()
'Realiza el registro del ticket creado en el archivo de excel "D:\AutotikectingBaja.xlsx!
'Create the link with the Excel application
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
sFileName = "D:\AutotikectingBaja.xlsx"
fileDoesExist = Dir(sFileName) > ""
' It checks if the file exists, if it opens it, if not it creates it
If fileDoesExist Then
Set xlBook = xlApp.Workbooks.Open(sFileName)
Else
Set xlBook = xlApp.Workbooks.Add
xlBook.SaveAs "D:\AutotikectingBaja.xlsx"
End If
Set xlSheet = xlBook.Sheets("Sheet1")
rCount = 1
'Look for the first empty line, if it is 1 load the headers first
While xlSheet.Range("A" & rCount) <> ""
rCount = rCount + 1
Wend
If rCount = 1 Then
xlSheet.Range("A" & rCount) = "No de ticket"
xlSheet.Range("B" & rCount) = "Fecha Creacion"
xlSheet.Range("C" & rCount) = "Hora Creacion"
xlSheet.Range("D" & rCount) = "Area asignada"
xlSheet.Range("E" & rCount) = "Status"
xlSheet.Range("F" & rCount) = "StatusType"
xlSheet.Range("G" & rCount) = "StatusName"
rCount = rCount + 1
End If
xlSheet.Range("A" & rCount) = rticket
xlSheet.Range("B" & rCount) = nfecha
xlSheet.Range("C" & rCount) = nTime
xlSheet.Range("D" & rCount) = areatick
xlSheet.Range("E" & rCount) = rstatus
xlSheet.Range("F" & rCount) = rStsType
xlSheet.Range("G" & rCount) = rStsName
'Guarda y Cierra el archivo
xlBook.Close SaveChanges:=True
xlApp.Quit
End Sub