公共变量值未重置

Posted 2023-02-19

【中文标题】公共变量值未重置

【英文标题】：Public variable value is not reset

【发布时间】：2021-07-27 18:55:09

【问题描述】：

我在少数程序（如以下示例）上使用公共“reportName”变量，这些程序将 xml 文件转换为 excel 表。问题是“reportName”变量的值始终保持为“Items”，知道为什么吗？

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."

结束子

'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

'回家 设置 ws = Worksheets("home")

'获取凭证 用户名 = Worksheets(ws.Name).tb_username.Text 密码 = 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

'通过代号获取工作表 公共函数 getWorkSheetByCodeName(codeName As String) 作为工作表 将 Wks 调暗为工作表 对于工作表中的每个 Wks If Wks.codeName = codeName Then 设置 getWorkSheetByCodeName = Wks 退出 万一 下一个

结束函数

'两个标签之间的子字符串 公共函数 f_subStringByTag(ByVal myString, ByVal startTag, ByVal endTag) 昏暗 startPos 只要 Dim endPos 只要 将子字符串调暗为字符串

'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

结束函数

'以 UTF8 解码 base64 文本并保存到文件 函数 f_textBase64Decodefile(strBase64, reportName)

将 strFile 调暗为字符串：strFile = Environ$("USERPROFILE") & "\Downloads" & reportName & ".xml" 昏暗的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

结束函数

【问题讨论】：

你在哪里声明了reportName 变量（As Public）。您在哪里更改/重置其值，以检查您所说的内容？它是否声明在标准模块之上（在声明区域中）？它的值在哪里发生了变化，是什么让您认为代码没有按应有的方式运行？

获取Rubberduck，然后右键单击reportName变量并从Rubberduck上下文菜单中选择“查找所有引用”；您将获得读取变量的所有位置以及写入变量的所有位置。此外，您可能首先不需要reportName 全局变量：考虑更改该过程以采用ByVal reportName As String 参数，并在调用站点提供适当的值。

s_refresh_Items() 过程完美运行，但是当我运行 Public Sub s_refresh_Sales_Orders_History() 时，我在 Dim Data As Variant: ReDim Data(1 To myNodes.Length, 1 To 22) 行中出现错误错误是：“运行时错误 9：下标超出范围”

myNodes.Length 在 VBA 中没有任何意义。如果你需要使用字符串长度，你应该使用Len(myNodes)。但我无法想象以这种方式使用它的目的......你能澄清一下这个需求吗？

【参考方案1】：

您在第一行将 reportName 的值设置为“Items”，然后再将其设置为其他值。为什么你会期望它改变？

【讨论】：

我可以确认，这是正确的答案。

我确实在下一个过程中将其更改为 reportName = "Orders"，然后我使用类似的过程读取不同的 xml 文件，但我总是得到“未设置对象或变量”

您应该编辑原始问题以添加所有相关代码。这应该包括引发错误的实际行。我们只能帮助您处理您实际发布的代码。

s_refresh_Items() 过程完美运行，但是当我运行 Public Sub s_refresh_Sales_Orders_History() 时，我在 Dim Data As Variant: ReDim Data(1 To myNodes.Length, 1 To 22) 行中出现错误错误是：“运行时错误 9：下标超出范围”

代码似乎拒绝读取“Orders.xml”文件并卡在“Item.xml”文件中