1
votes

enter image description hereI am using a public "reportName" variable on few procedures ( like the following example ) those procedures convert xml file to excel sheet. the problem is that the value of the "reportName" variable always remain as "Items" any idea why ?

Option Explicit
Global reportName As String

'Refresh Items
Public Sub s_refresh_Items()

'Declare our variables
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet
Dim reportBytes As String
Dim xmlDoc As MSXML2.DOMDocument60: Set xmlDoc = New 
SXML2.DOMDocument60
  
'Get Sheet by CodeName
Set ws = getWorkSheetByCodeName("items")
  
'Clear Excel contents
If ws.UsedRange.Rows.Count > 1 Then
ws.Rows("2:" & ws.UsedRange.Rows.Count).EntireRow.Delete
End If

'Show user form uf_loading_in_progress
uf_loading_in_progress.Show
DoEvents

'Get report name
reportName = "Items"

'Call the function
reportBytes = f_execWsSoap("/Custom/Logistics/Inventory/Reports/XX 
INV005-Items List.xdo", reportName)

'Check error
If reportBytes = "-1" Then
Debug.Print "Exit s_refresh_Items"
uf_loading_in_progress.Hide
Exit Sub
End If

xmlDoc.Load (Environ$("USERPROFILE") & "\Downloads" & reportName & 
".xml")
Dim myNodes As MSXML2.IXMLDOMNodeList: Set myNodes =   
xmlDoc.getElementsByTagName("G_1")
Dim Data As Variant: ReDim Data(1 To myNodes.Length, 1 To 17)
Dim myNode As MSXML2.IXMLDOMNode
Dim i As Long

For Each myNode In myNodes
    i = i + 1
    Data(i, 1) = myNode.SelectNodes("ORGANIZATION_CODE")(0).Text
    Data(i, 2) = myNode.SelectNodes("ITEM_NUMBER")(0).Text
    Data(i, 3) = myNode.SelectNodes("ITEM_DESCRIPTION")(0).Text
    Data(i, 4) = myNode.SelectNodes("CATEGORY_CODE")(0).Text
    Data(i, 5) = myNode.SelectNodes("ITEM_LONG_DESCRIPTION")(0).Text
    Data(i, 6) = myNode.SelectNodes("ITEM_TYPE_NAME")(0).Text
    Data(i, 7) = myNode.SelectNodes("CREATION_DATE")(0).Text
    Data(i, 8) = myNode.SelectNodes("ITEM_REVISION")(0).Text
    Data(i, 9) = myNode.SelectNodes("INVENTORY_ITEM_STATUS_CODE")
    (0).Text
    Data(i, 10) = myNode.SelectNodes("PURCHASING_ENABLED_FLAG")(0).Text
    Data(i, 11) = myNode.SelectNodes("CUSTOMER_ORDER_ENABLED_FLAG")
    (0).Text
    Data(i, 12) = myNode.SelectNodes("UNIT_OF_MEASURE")(0).Text
    Data(i, 13) = myNode.SelectNodes("LIST_PRICE")(0).Text
    Data(i, 14) = myNode.SelectNodes("TP_TYPE")(0).Text
    Data(i, 15) = myNode.SelectNodes("MANUFACTURER_NAME")(0).Text
    Data(i, 16) = myNode.SelectNodes("MFG_PART_NUMBER")(0).Text
    Data(i, 17) = myNode.SelectNodes("MFG_ITEM_CREATION_DATE")(0).Text
        
Next myNode
  
ws.Range("A2").Resize(i, 17).Value = Data

'Clean up
Set xmlDoc = Nothing

'Delete File
Kill (Environ$("USERPROFILE") & "\Downloads\" & reportName & ".xml")

uf_loading_in_progress.Hide
home.cb_items.Caption = Now
MsgBox "Items refresh completed successfully."

End Sub


'Refresh Sales Orders History
Public Sub s_refresh_Sales_Orders_History()

'Declare our variables
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet
Dim reportBytes As String
Dim xmlDoc As MSXML2.DOMDocument60: Set xmlDoc = New 
MSXML2.DOMDocument60
  
'Get Sheet by CodeName
Set ws = getWorkSheetByCodeName("history")
  
'Clear Excel contents
If ws.UsedRange.Rows.Count > 1 Then
 ws.Rows("2:" & ws.UsedRange.Rows.Count).EntireRow.Delete
End If

'Show user form uf_loading_in_progress
uf_loading_in_progress.Show
DoEvents

'Get report name
reportName = "Items"

'Call the function
reportBytes = f_execWsSoap("/Custom/Logistics/Order 
Management/Reports/XX DOO004-Sales Order History.xdo", reportName)

'Check error
If reportBytes = "-1" Then
Debug.Print "Exit s_refresh_Items"
  uf_loading_in_progress.Hide
  Exit Sub
End If

xmlDoc.Load (Environ$("USERPROFILE") & "\Downloads" & reportName & 
".xml")
Dim myNodes As MSXML2.IXMLDOMNodeList: Set myNodes = 
xmlDoc.getElementsByTagName("G_1")
Dim Data As Variant: ReDim Data(1 To myNodes.Length, 1 To 22)
Dim myNode As MSXML2.IXMLDOMNode
Dim i As Long

For Each myNode In myNodes
    i = i + 1
    Data(i, 1) = myNode.SelectNodes("OPERATING_UNIT")(0).Text
    Data(i, 2) = myNode.SelectNodes("PARTY_NAME")(0).Text
    Data(i, 3) = myNode.SelectNodes("CUSTOMER_NUMBER")(0).Text
    Data(i, 4) = myNode.SelectNodes("BILL_TERRITORY_SHORT_NAME")
(0).Text
    Data(i, 5) = myNode.SelectNodes("ORDER_NUMBER")(0).Text
    Data(i, 6) = myNode.SelectNodes("CUSTOMER_PO")(0).Text
    Data(i, 7) = myNode.SelectNodes("LINE_NUMBER")(0).Text
    Data(i, 8) = myNode.SelectNodes("ORGANIZATION_CODE")(0).Text
    Data(i, 9) = myNode.SelectNodes("LINE_CREATION_DATE")(0).Text
    Data(i, 10) = myNode.SelectNodes("FULFILL_STATUS_CODE")(0).Text
    Data(i, 11) = myNode.SelectNodes("ITEM")(0).Text
    Data(i, 12) = myNode.SelectNodes("ITEM_DESCRIPTION")(0).Text
    Data(i, 13) = myNode.SelectNodes("SHIPMENT_ORDERED_QUANTITY")
(0).Text
    Data(i, 14) = myNode.SelectNodes("SHIPMENT_SHIPPED_QUANTITY")
(0).Text
    Data(i, 15) = myNode.SelectNodes("FULFILL_ACTUAL_COMPLETION_DATE")
(0).Text
    Data(i, 16) = myNode.SelectNodes("PAYMENT_TERMS")(0).Text
    Data(i, 17) = myNode.SelectNodes("CURRENCY")(0).Text
    Data(i, 18) = myNode.SelectNodes("UNIT_SELLING_PRICE")(0).Text
    Data(i, 19) = myNode.SelectNodes("EXTENDED_AMOUNT")(0).Text
    Data(i, 20) = myNode.SelectNodes("USD_AMOUNT")(0).Text
    Data(i, 21) = myNode.SelectNodes("DELIVERY")(0).Text
    Data(i, 22) = myNode.SelectNodes("HEADER_CREATED_BY")(0).Text
        
Next myNode
  
ws.Range("A2").Resize(i, 22).Value = Data

'Clean up
Set xmlDoc = Nothing

'Delete File
Kill (Environ$("USERPROFILE") & "\Downloads\" & reportName & ".xml")

uf_loading_in_progress.Hide
home.cb_items.Caption = Now
MsgBox "Items refresh completed successfully."

End Sub

'Execute WS soap
Public Function f_execWsSoap(ByVal reportAbsolutePath As String,  
Optional reportName As String, Optional ByVal parameterNameValuesXML As 
String)
Dim sURL As String
Dim sEnv As String
Dim base64reportBytes As String
Dim reportBytes As String
Dim httpReq As New XMLHTTP60
Dim Response As String
Dim username As String
Dim password As String
Dim faultCode As String
Dim faultString As String
Dim strSelectedItem As String
Dim param1 As Variant
Dim ws As Worksheet

'Get Home Set ws = Worksheets("home")

'Get Credentials username = Worksheets(ws.Name).tb_username.Text password = Worksheets(ws.Name).tb_password.Text

'Check if the username is null
If username = "" Then
  MsgBox "Insert the Username"
  f_execWsSoap = "-1"
  Exit Function
End If

'Check if the password is null
If password = "" Then
  MsgBox "Insert the Password"
  f_execWsSoap = "-1"
  Exit Function
End If

'Get report parameters

If reportName = "Items" Then
param1 = "P_ORGANIZATION_CODE"
strSelectedItem = Worksheets(ws.Name).cb_item_organizations.Value
End If

If reportName = "Orders" Then
param1 = "P_BU_NAME"
strSelectedItem = Worksheets(ws.Name).cb_business_unit_so_history.Value
End If

'Url
sURL = "https://org.com/xmlpserver/services/v2/ReportService"

'Request
sEnv = sEnv & "<soapenv:Envelope  
xmlns:soapenv=""http://schemas.xmlsoap.org/soap/envelope/"" 
xmlns:v2=""http://xmlns.oracle.com/oxp/service/v2"">"
sEnv = sEnv & " <soapenv:Header/>"
sEnv = sEnv & " <soapenv:Body>"
sEnv = sEnv & "  <v2:runReport>"
sEnv = sEnv & "   <v2:reportRequest>"
sEnv = sEnv & "    <v2:attributeFormat>xml</v2:attributeFormat>"
sEnv = sEnv & "    <v2:attributeLocale>us-US</v2:attributeLocale>"
sEnv = sEnv & "    <v2:reportAbsolutePath>" + reportAbsolutePath + 
"</v2:reportAbsolutePath>"
sEnv = sEnv & "    <v2:parameterNameValues>"
sEnv = sEnv & "       <v2:listOfParamNameValues>"
'If Not IsMissing(parameterNameValuesXML) Then
'    sEnv = sEnv & parameterNameValuesXML
'End If

'Parameters - Added by me
sEnv = sEnv & "    <v2:item>"
sEnv = sEnv & "      <v2:name>" + param1 + "</v2:name>"
sEnv = sEnv & "         <v2:values>"
sEnv = sEnv & "           <v2:item>" + strSelectedItem + "</v2:item>"
sEnv = sEnv & "         </v2:values>"
sEnv = sEnv & "    </v2:item>"

sEnv = sEnv & "        </v2:listOfParamNameValues>"
sEnv = sEnv & "    </v2:parameterNameValues>"
sEnv = sEnv & "   </v2:reportRequest>"
sEnv = sEnv & "   <v2:userID>" + username + "</v2:userID>"
sEnv = sEnv & "   <v2:password>" + password + "</v2:password>"
sEnv = sEnv & "  </v2:runReport>"
sEnv = sEnv & " </soapenv:Body>"
sEnv = sEnv & "</soapenv:Envelope>"

'Invoke the web service
httpReq.Open "POST", sURL, False

'Set header values
httpReq.setRequestHeader "Content-Type", "text/xml"
httpReq.setRequestHeader "SOAPAction", False

'Send request
httpReq.send sEnv

'Response
Response = httpReq.responseText
    
'Check Error
faultCode = f_subStringByTag(Response, "<faultcode>", "</faultcode>")

'Debug.Print "faultCode: " + faultCode
If faultCode <> "" Then
  faultString = f_subStringByTag(Response, "<faultstring>", 
"</faultstring>")
  If InStr(1, faultString, "SecurityException") > 0 Then
    MsgBox "Invalid Username or Password."
    f_execWsSoap = "-1"
  Else
    MsgBox faultString
    f_execWsSoap = "-1"
  End If
  Exit Function
End If

'Get reportBytes
reportBytes = f_subStringByTag(Response, "<reportBytes>", 
"</reportBytes>")
 
'Debug.Print reportBytes
Debug.Print "START base64reportBytes " & Time

'Decode reportBytes
base64reportBytes = f_textBase64Decodefile(reportBytes, reportName)

Debug.Print "END base64reportBytes " & Time
 
'Clean up
Set httpReq = Nothing

'No error
f_execWsSoap = base64reportBytes

End Function

'Get Worksheet by code name Public Function getWorkSheetByCodeName(codeName As String) As Worksheet Dim Wks As Worksheet For Each Wks In Worksheets If Wks.codeName = codeName Then Set getWorkSheetByCodeName = Wks Exit For End If Next

End Function

'Substring between 2 tags Public Function f_subStringByTag(ByVal myString, ByVal startTag, ByVal endTag) Dim startPos As Long Dim endPos As Long Dim subString As String

'startPos
startPos = InStr(1, myString, startTag)
If startPos = 0 Then
 Exit Function
End If

'endPos
endPos = InStr(1, myString, endTag)

'subString
startPos = startPos + Len(startTag)
subString = Mid(myString, startPos, endPos - startPos)

f_subStringByTag = subString

End Function

'Decode a text base64 in UTF8 and save to file Function f_textBase64Decodefile(strBase64, reportName)

Dim strFile As String: strFile = Environ$("USERPROFILE") & "\Downloads" & reportName & ".xml" Dim b

With CreateObject("Microsoft.XMLDOM").createElement("b64")
    .DataType = "bin.base64": .Text = strBase64
    b = .nodeTypedValue
    With CreateObject("ADODB.Stream")
        .Open: .Type = 1: .Write b: .Position = 0: .Type = 2: .Charset = "utf-8"
                    
         If Len(Dir$(strFile)) > 0 Then Kill strFile
        .SaveToFile (Environ$("USERPROFILE") & "\Downloads\" & reportName & ".xml")
       
        .Close
    End With
End With

End Function

1
Where did you declare reportName variable (As Public). Where do you change/reset its value, in order to check what you say? Is it declared on top of a standard module (in the declarations area)? Where its value is changed and what made you think that the code does not behave as it should?FaneDuru
Get Rubberduck, then right-click the reportName variable and select "Find all references" from the Rubberduck context menu; you'll get all the places where the variable is being read and all the places where it's being written. Also you probably don't need a reportName global variable in the first place: consider changing that procedure to take a ByVal reportName As String parameter, and provide an appropriate value at the call sites.Mathieu Guindon
the s_refresh_Items() procedure works perfect but then when i run the Public Sub s_refresh_Sales_Orders_History() i get error in line Dim Data As Variant: ReDim Data(1 To myNodes.Length, 1 To 22) the error is : "Run-time error 9: Subscript out of range"Shlomo
myNodes.Length has no meaning in VBA. If you need using the string length you should use Len(myNodes). But I cannot imagine the purpose of using it in such a way... Can you clarify this need?FaneDuru

1 Answers

0
votes

You set the value of reportName to "Items" in the first line and then never set it to another value. Why would you expect it to change?