3,887 questions
Excel VBA/XML.send getting error 287 although send seemed to work.
![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(227.2, 30%, 32%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EDG%3C/text%3E%3C/svg%3E)
Daniel Gramza
1
Reputation point
Folks,
Trying to help a customer update an old Redmine system and they use a couple of macro enabled spreadsheets to make REST.API/XML calls into redmine. the spreadsheet works okay in the old system but when I test the spreadsheet to the new system (URL + access key) I get error 287 after the oXmlHttp.send command for the "PUT" portion of the logic below. Seems like 287 seems to suggest missing object library in References but I'm not a VBA expert. The first record in Redmine actually gets updated successfully but the spreadsheet then takes an error and stops. The system log on the redmine side doesn't seem to indicate an error occurred there. Return Code 204 (completed ok no data to return) This macro code is pretty old and i didn't write it. Anyone have any ideas? This is just the updateallissues portion of the Macros which inspects some data in a worksheet to see if certain issues need to be updated in redmine. example. issue(s) with status "new' need to be updated to status "part pulled"
Public Sub updateAllIssues()
Application.EnableEvents = False
Dim lngMaxRow As Long
Dim projectRow As Long
Dim targetProjectID As String
Dim trackerID As String
Dim xmlInput As String
Dim issueURL As String
Dim oXmlHttp As New MSXML2.XMLHTTP60
Dim oXmlReturn As MSXML2.DOMDocument60
Dim xPrjDetails As MSXML2.IXMLDOMNode
Dim xProject As MSXML2.IXMLDOMNode
Dim xChild As MSXML2.IXMLDOMNode
Dim totalChanges As Long
Dim currentRecord As Long
totalChanges = 0
currentRecord = 0
MSG1 = MsgBox("You are about to update CRM. Are you sure?", vbYesNo, "Are you sure you want save?")
If MSG1 = vbYes Then
lngMaxRow = Sheets("CRM Project Inventory").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lngMaxRow
With Sheets("CRM Project Inventory")
If .Cells(i, "N").Value = "Update" Then
totalChanges = totalChanges + 1
End If
End With
Next i
If totalChanges > 0 Then
For i = 2 To lngMaxRow
Application.StatusBar = "Progress: " & currentRecord & " of " & totalChanges & ": " & Format(currentRecord / totalChanges, "0%")
DoEvents
If Sheets("CRM Project Inventory").Cells(i, "N").Value = "Update" Then
If Sheets("CRM Project Inventory").Cells(i, "A").Value = "" Then
projectRow = Sheets("CRM Project Inventory").Range("A" & Rows.Count).End(xlUp).Row
issueURL = ACCESS_URL & "issues.xml" & "?key=" & ACCESS_KEY
xmlInput = "<?xml version=""1.0""?>"
xmlInput = xmlInput & "<issue>"
For j = 2 To projectRow
With Sheets("Active Projects")
If .Cells(j, "B").Value = Sheets("CRM Project Inventory").Cells(i, "B").Value Then
xmlInput = xmlInput & "<project_id>" & .Cells(j, "A").Value & "</project_id>"
End If
End With
Next j
xmlInput = xmlInput & "<tracker_id>5</tracker_id>"
With Sheets("CRM Project Inventory")
Select Case .Cells(i, "C").Value
Case "New"
xmlInput = xmlInput & "<status_id>1</status_id>"
Case "In Progress"
xmlInput = xmlInput & "<status_id>2</status_id>"
Case "Resolved"
xmlInput = xmlInput & "<status_id>3</status_id>"
Case "Complete"
xmlInput = xmlInput & "<status_id>5</status_id>"
Case "Ordered"
xmlInput = xmlInput & "<status_id>7</status_id>"
Case "Recieved"
xmlInput = xmlInput & "<status_id>8</status_id>"
Case "Not Needed"
xmlInput = xmlInput & "<status_id>9</status_id>"
Case "On Hold"
xmlInput = xmlInput & "<status_id>10</status_id>"
Case "Part Pulled"
xmlInput = xmlInput & "<status_id>11</status_id>"
Case "Need To Order"
xmlInput = xmlInput & "<status_id>12</status_id>"
Case "Customer Supplied"
xmlInput = xmlInput & "<status_id>13</status_id>"
Case "L&M Stock"
xmlInput = xmlInput & "<status_id>14</status_id>"
Case Else
MsgBox ("Invalid Status")
Exit Sub
End Select
xmlInput = xmlInput & "<subject>" & xmlIllegal(.Cells(i, "D").Value) & "</subject>"
xmlInput = xmlInput & "<description>" & xmlIllegal(.Cells(i, "E").Value) & "</description>"
xmlInput = xmlInput & "<custom_fields type=""array"">"
xmlInput = xmlInput & "<custom_field id=""2""><value>" & xmlIllegal(.Cells(i, "G").Value) & "</value></custom_field>"
xmlInput = xmlInput & "<custom_field id=""3""><value>" & xmlIllegal(.Cells(i, "H").Value) & "</value></custom_field>"
xmlInput = xmlInput & "<custom_field id=""4""><value>" & xmlIllegal(.Cells(i, "I").Value) & "</value></custom_field>"
xmlInput = xmlInput & "<custom_field id=""5""><value>" & xmlIllegal(.Cells(i, "J").Value) & "</value></custom_field>"
xmlInput = xmlInput & "<custom_field id=""6""><value>" & xmlIllegal(.Cells(i, "K").Value) & "</value></custom_field>"
xmlInput = xmlInput & "<custom_field id=""9""><value>" & xmlIllegal(.Cells(i, "L").Value) & "</value></custom_field>"
xmlInput = xmlInput & "<custom_field id=""10""><value>" & xmlIllegal(.Cells(i, "M").Value) & "</value></custom_field>"
xmlInput = xmlInput & "</custom_fields>"
xmlInput = xmlInput & "</issue>"
End With
Set oXmlHttp = New MSXML2.XMLHTTP60
oXmlHttp.Open "POST", issueURL, False
oXmlHttp.SetRequestHeader "Content-Type", "text/xml"
oXmlHttp.SetRequestHeader "Connection", "Keep-Alive"
oXmlHttp.SetRequestHeader "Accept-Language", "en"
oXmlHttp.Send xmlInput
Debug.Print oXmlHttp.ResponseText
Set oXmlReturn = New MSXML2.DOMDocument60
oXmlReturn.LoadXML oXmlHttp.ResponseText
currentRecord = currentRecord + 1
Else
With Sheets("CRM Project Inventory")
issueURL = ACCESS_URL & "issues/" & .Cells(i, "A").Value & ".xml" & "?key=" & ACCESS_KEY
xmlInput = "<?xml version=""3.0""?>"
xmlInput = xmlInput & "<issue>"
Select Case .Cells(i, "C").Value
Case "New"
xmlInput = xmlInput & "<status_id>1</status_id>"
Case "In Progress"
xmlInput = xmlInput & "<status_id>2</status_id>"
Case "Resolved"
xmlInput = xmlInput & "<status_id>3</status_id>"
Case "Complete"
xmlInput = xmlInput & "<status_id>5</status_id>"
Case "Ordered"
xmlInput = xmlInput & "<status_id>7</status_id>"
Case "Recieved"
xmlInput = xmlInput & "<status_id>8</status_id>"
Case "Not Needed"
xmlInput = xmlInput & "<status_id>9</status_id>"
Case "On Hold"
xmlInput = xmlInput & "<status_id>10</status_id>"
Case "Part Pulled"
xmlInput = xmlInput & "<status_id>11</status_id>"
Case "Need To Order"
xmlInput = xmlInput & "<status_id>12</status_id>"
Case "Customer Supplied"
xmlInput = xmlInput & "<status_id>13</status_id>"
Case "L&M Stock"
xmlInput = xmlInput & "<status_id>14</status_id>"
Case Else
MsgBox ("Invalid Status")
Exit Sub
End Select
xmlInput = xmlInput & "<description>" & xmlIllegal(.Cells(i, "E").Value) & "</description>"
xmlInput = xmlInput & "<custom_fields type=""array"">"
xmlInput = xmlInput & "<custom_field id=""2""><value>" & xmlIllegal(.Cells(i, "G").Value) & "</value></custom_field>"
xmlInput = xmlInput & "<custom_field id=""3""><value>" & xmlIllegal(.Cells(i, "H").Value) & "</value></custom_field>"
xmlInput = xmlInput & "<custom_field id=""4""><value>" & xmlIllegal(.Cells(i, "I").Value) & "</value></custom_field>"
xmlInput = xmlInput & "<custom_field id=""5""><value>" & xmlIllegal(.Cells(i, "J").Value) & "</value></custom_field>"
xmlInput = xmlInput & "<custom_field id=""6""><value>" & xmlIllegal(.Cells(i, "K").Value) & "</value></custom_field>"
xmlInput = xmlInput & "<custom_field id=""9""><value>" & xmlIllegal(.Cells(i, "L").Value) & "</value></custom_field>"
xmlInput = xmlInput & "<custom_field id=""10""><value>" & xmlIllegal(.Cells(i, "M").Value) & "</value></custom_field>"
xmlInput = xmlInput & "</custom_fields>"
xmlInput = xmlInput & "</issue>"
End With
Set oXmlHttp = New MSXML2.XMLHTTP60
oXmlHttp.Open "PUT", issueURL, False
oXmlHttp.SetRequestHeader "Content-Type", "text/xml"
oXmlHttp.SetRequestHeader "Connection", "Keep-Alive"
oXmlHttp.SetRequestHeader "Accept-Language", "en"
**oXmlHttp.Send xmlInput** IT TAKES AN ERROR 287 HERE AND STOPS
Debug.Print oXmlHttp.ResponseText
Set oXmlReturn = New MSXML2.DOMDocument60
oXmlReturn.LoadXML oXmlHttp.ResponseText
currentRecord = currentRecord + 1
End If
End If
Next i
End If
Application.StatusBar = False
Call log_action_to_file("CRM ISSUES SAVED", , 9, , currentRecord)
Call retrieveAllIssues
End If
Application.EnableEvents = True
End Sub
Microsoft 365 and Office Excel For business Windows
Developer technologies Visual Basic for Applications
1,507 questions
{count} votes
-
Dillon Silzer 57,826 Reputation points Volunteer Moderator2022-07-21T05:09:55.623+00:00 Check:
issueURL = ACCESS_URL & "issues/" & .Cells(i, "A").Value & ".xml" & "?key=" & ACCESS_KEY << This could be your issue.
See how MSXML2.XMLHTTP works below and see if your issueURL works with the code in the link and what the responseText is:
-
Daniel Gramza 1 Reputation point
2022-07-21T20:55:55.493+00:00 didn't see anything in there that helps me.
I have the MSXML v6.0 reference checked. and the examples are basically the same as what i have.
what made you think this is where the issue is for a error 287
https://learn.microsoft.com/en-us/office/vba/Language/How-to/user-defined-type-not-defined -
Viorel 122.5K Reputation points2022-07-22T18:36:47.437+00:00 Do you really need version=""3.0"" instead of usual version=""1.0""?
You can also visit the forum and documentation sites of the third-party product.
Sign in to comment
Sign in to answer