根据条件选择，将值传递为一个组合框的列表

Function GetArrFromXML(ByRef FieldArr, ByRef Arr1, Xml1)

 

Dim i, j, lsXml, lsChar, liStar, liEnd, lsStar, lsEnd, liLen,Dic1

 

lsStar = "<FieldName>"

 

lsEnd = "</FieldName>"

 

liLen = Len(lsStar)

 

i = InStr(1,Xml1, "<FieldInfoArray>",1)

 

If i <> 0 Then

 

lsXml = Mid(Xml1, i, Len(Xml1))

 

Else

 

Exit Function

 

End If

 

liStar = InStr(1, lsXml, lsStar, 1)

 

liEnd = InStr(1, lsXml, lsEnd, 1)

 

Do While liEnd > 0

 

If IsArray(FieldArr) Then

 

ReDim Preserve FieldArr(UBound(FieldArr) + 1)

 

Else

 

ReDim FieldArr(0)

 

End If

 

FieldArr(UBound(FieldArr)) = Mid(lsXml, liStar + liLen, liEnd - liStar - liLen)

 

liStar = InStr(liEnd+1, lsXml, lsStar, 1)

 

liEnd = InStr(liEnd+1, lsXml, lsEnd, 1)

 

Loop

 

 

Set Dic1 = CreateObject("Scripting.Dictionary")

 

For i = 0 To UBound(FieldArr, 1)

 

Dic1.Add FieldArr(i), CStr(i)

 

Next

liStar = InStr(1, lsXml, "<RowNum>", 1)

 

liEnd = InStr(1, lsXml, "</RowNum>", 1)

 

i = Int(Mid(lsXml,  liStar + Len("<RowNum>"), liEnd - liStar - Len("<RowNum>")))

 

ReDim Arr1(UBound(FieldArr, 1), i - 1)

 

For i = 0 To UBound(FieldArr, 1)

 

lsStar = "<" & FieldArr(i) & ">"

 

lsEnd = "</" & FieldArr(i) & ">"

 

liLen = Len(lsStar)

 

j = 0

 

liStar = InStr(1, lsXml, lsStar, 1)

 

liEnd = InStr(1, lsXml, lsEnd, 1)

 

Do While liEnd > 0  'i =  dic1.key(FieldArr(i))

 

Arr1(i, j) = Mid(lsXml, liStar + liLen, liEnd - liStar - liLen)

 

liStar = InStr(liEnd+1, lsXml, lsStar, 1)

 

liEnd = InStr(liEnd+1, lsXml, lsEnd, 1)

 

j = j + 1

 

Loop

 

Next

 

End Function

 

 

'注释:

Sub eb_Sheng_CloseUp()

dim Arr,Dic

eb_shi.Clear

StrSql = "Select 城市 From 邮编区号 Where 省份 = '"+eb_Sheng.Text+"'"

StrRet = DBEngine.WebFunction("SqlQuery",StrSql,"")

 

GetArrFromXML Dic,Arr,strRet

FOR i=0 TO UBound(Arr,2)

 

eb_Shi.AddItem Arr(0,i)

 

NEXT

End Sub