S
steve1040
For each cell I want to send the value to my getcat routine and return
the value given by program to place in the column next to it.
So if I have a sheet with
iPod
Cheese
Laptop
Printer
in column B
I want to pass each value to getcat() and getcat() send back a value
that is placed in col c of same row.
Also the results from getcat are not instant some take longer than
other. I need to make code wait for response.
Thanks
*****************************************************
Here is my code
This seems to go through each row but how do I make value available to
getcat
Sub LookupCat()
Application.ScreenUpdating = False
Dim rCell As Range
Dim rRng As Range
Dim kword As String
With Worksheets("EbayStore_Inventory_Category")
Set rRng = .Range("B1", .Cells(.Rows.Count, "B").End(xlUp))
End With
For Each rCell In rRng.Cells
kword = rCell.Value
MsgBox kword
'...
Next
Application.ScreenUpdating = True
End Sub
*******************************************************
Sub getcat()
Dim requestToken As String
Dim devID As String
Dim appID As String
Dim certID As String
Dim userToken As String
Dim serverUrl As String
Dim callName As String
Dim siteID As String
Dim version As String
Dim xmlDoc As MSXML.DOMDocument 'to load the request
Dim request As MSXML.XMLHTTPRequest 'to send the request
Dim response As MSXML.DOMDocument 'to get the response
Dim appDoc As MSXML.DOMDocument 'to get the values from the
config file
Dim filePath As String 'to get the file path of the
resources used by this app
Dim result As String
'clear the response
'lblResponse.Caption = ""
'If txtQuery.Text = "" Then
' MsgBox "You need to enter a query"
' txtQuery.SetFocus
'Else
'get the path of the resources used by this app
Dim fso As FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
filePath = fso.GetAbsolutePathName("H:\Auctions
\vb6_eBay_codesamples\GetSuggestedCategories")
'Get the values specified in the config file
Set appDoc = New DOMDocument
appDoc.Load (filePath & "\app.config")
'Get the specifed key's node
Dim node As MSXML.IXMLDOMNode
'Get the DevID
Set node = appDoc.SelectSingleNode("configuration/appSettings/
add[@key='DevID']")
devID = node.Attributes.getNamedItem("value").Text
'Get the AppID
Set node = appDoc.SelectSingleNode("/configuration/appSettings/
add[@key='AppID']")
appID = node.Attributes.getNamedItem("value").Text
'Get the CertID
Set node = appDoc.SelectSingleNode("/configuration/appSettings/
add[@key='CertID']")
certID = node.Attributes.getNamedItem("value").Text
'Get the UserToken
Set node = appDoc.SelectSingleNode("/configuration/appSettings/
add[@key='UserToken']")
userToken = node.Attributes.getNamedItem("value").Text
'Get the ServerURL
Set node = appDoc.SelectSingleNode("/configuration/appSettings/
add[@key='ServerUrl']")
serverUrl = node.Attributes.getNamedItem("value").Text
callName = "GetSuggestedCategories"
'SiteID Indicates the eBay site to associate the call with
'SiteID = 0 (US) - UK = 3, Canada = 2, Australia = 15, ....
siteID = "0"
'API version used to make the call
version = "551"
'Load the XML Document to Use for this Request
Set xmlDoc = New MSXML.DOMDocument
'Get XML Document from file
xmlDoc.Load (filePath & "\request.xml")
'Set the various node values
xmlDoc.SelectSingleNode("GetSuggestedCategoriesRequest/
RequesterCredentials/eBayAuthToken").nodeTypedValue = userToken
'set the query to get the suggested categories for
xmlDoc.SelectSingleNode("GetSuggestedCategoriesRequest/
Query").nodeTypedValue = kword 'txtQuery.Text
'Send the request and get the resonse document
'Create a new HTTP Request object
Set request = New MSXML.XMLHTTPRequest
'add the required headers
With request
.Open "POST", serverUrl, False
.setRequestHeader "Content-Type", "text/xml"
.setRequestHeader "X-EBAY-API-COMPATIBILITY-LEVEL",
version
.setRequestHeader "X-EBAY-API-DEV-NAME", devID
.setRequestHeader "X-EBAY-API-APP-NAME", appID
.setRequestHeader "X-EBAY-API-CERT-NAME", certID
.setRequestHeader "X-EBAY-API-CALL-NAME", callName
.setRequestHeader "X-EBAY-API-SITEID", siteID
.send xmlDoc
End With
If request.Status = 200 Then 'Successful
'set response as an XML Document
Set response = request.responseXML
End If
'Request could not be executed successfully
If response Is Nothing Then
' lblResponse.Caption = "Request Could Not Be Sent"
'Request returned errors
ElseIf Not (response.SelectSingleNode
("GetSuggestedCategoriesResponse/Errors") Is Nothing) Then
Dim errorMsg As String
errorMsg = "ERROR: " & response.SelectSingleNode
("GetSuggestedCategoriesResponse/Errors/ErrorCode").Text & " - " & _
response.SelectSingleNode
("GetSuggestedCategoriesResponse/Errors/ShortMessage").Text
If Not (response.SelectSingleNode
("GetSuggestedCategoriesResponse/Errors/LongMessage") Is Nothing) Then
errorMsg = errorMsg & vbCrLf &
response.SelectSingleNode("GetSuggestedCategoriesResponse/Errors/
LongMessage").Text
End If
'lblResponse.Caption = errorMsg
'Request was Successful!
Else
'Display the results
' result = "COUNT: " & response.SelectSingleNode
("GetSuggestedCategoriesResponse/CategoryCount").Text
result = result & vbCrLf & vbCrLf
Dim n, cn As IXMLDOMNode ' node and childnode
Dim Highest As Single
Dim HicatItem As String
Dim catID As String
Dim catName As String
Dim catItem As String
'go through each suggestedcategory
For Each n In response.SelectSingleNode
("GetSuggestedCategoriesResponse/SuggestedCategoryArray").ChildNodes
If n.nodeName = "SuggestedCategory" Then
' Dim catName, catID, catItems As String
catID = n.SelectSingleNode("Category/
CategoryID").Text
catName = n.SelectSingleNode("Category/
CategoryName").Text
catItems = n.SelectSingleNode
("PercentItemFound").Text
'output the suggested category
If CSng(catItems > Highest) Then
Highest = CSng(catItems)
catID = n.SelectSingleNode("Category/
CategoryID").Text
catName = n.SelectSingleNode("Category/
CategoryName").Text
HicatItem = catItems
'result = catName & " (" & catID & ")
- " & HicatItem & "%" & vbCrLf
result = catID & "|" & catName 'result
& catName & " (" & catID & ") - " & catItems & "%" & vbCrLf
End If
End If
Next
MsgBox result
'lblResponse.Caption = result
End If
'End If
End Sub
the value given by program to place in the column next to it.
So if I have a sheet with
iPod
Cheese
Laptop
Printer
in column B
I want to pass each value to getcat() and getcat() send back a value
that is placed in col c of same row.
Also the results from getcat are not instant some take longer than
other. I need to make code wait for response.
Thanks
*****************************************************
Here is my code
This seems to go through each row but how do I make value available to
getcat
Sub LookupCat()
Application.ScreenUpdating = False
Dim rCell As Range
Dim rRng As Range
Dim kword As String
With Worksheets("EbayStore_Inventory_Category")
Set rRng = .Range("B1", .Cells(.Rows.Count, "B").End(xlUp))
End With
For Each rCell In rRng.Cells
kword = rCell.Value
MsgBox kword
'...
Next
Application.ScreenUpdating = True
End Sub
*******************************************************
Sub getcat()
Dim requestToken As String
Dim devID As String
Dim appID As String
Dim certID As String
Dim userToken As String
Dim serverUrl As String
Dim callName As String
Dim siteID As String
Dim version As String
Dim xmlDoc As MSXML.DOMDocument 'to load the request
Dim request As MSXML.XMLHTTPRequest 'to send the request
Dim response As MSXML.DOMDocument 'to get the response
Dim appDoc As MSXML.DOMDocument 'to get the values from the
config file
Dim filePath As String 'to get the file path of the
resources used by this app
Dim result As String
'clear the response
'lblResponse.Caption = ""
'If txtQuery.Text = "" Then
' MsgBox "You need to enter a query"
' txtQuery.SetFocus
'Else
'get the path of the resources used by this app
Dim fso As FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
filePath = fso.GetAbsolutePathName("H:\Auctions
\vb6_eBay_codesamples\GetSuggestedCategories")
'Get the values specified in the config file
Set appDoc = New DOMDocument
appDoc.Load (filePath & "\app.config")
'Get the specifed key's node
Dim node As MSXML.IXMLDOMNode
'Get the DevID
Set node = appDoc.SelectSingleNode("configuration/appSettings/
add[@key='DevID']")
devID = node.Attributes.getNamedItem("value").Text
'Get the AppID
Set node = appDoc.SelectSingleNode("/configuration/appSettings/
add[@key='AppID']")
appID = node.Attributes.getNamedItem("value").Text
'Get the CertID
Set node = appDoc.SelectSingleNode("/configuration/appSettings/
add[@key='CertID']")
certID = node.Attributes.getNamedItem("value").Text
'Get the UserToken
Set node = appDoc.SelectSingleNode("/configuration/appSettings/
add[@key='UserToken']")
userToken = node.Attributes.getNamedItem("value").Text
'Get the ServerURL
Set node = appDoc.SelectSingleNode("/configuration/appSettings/
add[@key='ServerUrl']")
serverUrl = node.Attributes.getNamedItem("value").Text
callName = "GetSuggestedCategories"
'SiteID Indicates the eBay site to associate the call with
'SiteID = 0 (US) - UK = 3, Canada = 2, Australia = 15, ....
siteID = "0"
'API version used to make the call
version = "551"
'Load the XML Document to Use for this Request
Set xmlDoc = New MSXML.DOMDocument
'Get XML Document from file
xmlDoc.Load (filePath & "\request.xml")
'Set the various node values
xmlDoc.SelectSingleNode("GetSuggestedCategoriesRequest/
RequesterCredentials/eBayAuthToken").nodeTypedValue = userToken
'set the query to get the suggested categories for
xmlDoc.SelectSingleNode("GetSuggestedCategoriesRequest/
Query").nodeTypedValue = kword 'txtQuery.Text
'Send the request and get the resonse document
'Create a new HTTP Request object
Set request = New MSXML.XMLHTTPRequest
'add the required headers
With request
.Open "POST", serverUrl, False
.setRequestHeader "Content-Type", "text/xml"
.setRequestHeader "X-EBAY-API-COMPATIBILITY-LEVEL",
version
.setRequestHeader "X-EBAY-API-DEV-NAME", devID
.setRequestHeader "X-EBAY-API-APP-NAME", appID
.setRequestHeader "X-EBAY-API-CERT-NAME", certID
.setRequestHeader "X-EBAY-API-CALL-NAME", callName
.setRequestHeader "X-EBAY-API-SITEID", siteID
.send xmlDoc
End With
If request.Status = 200 Then 'Successful
'set response as an XML Document
Set response = request.responseXML
End If
'Request could not be executed successfully
If response Is Nothing Then
' lblResponse.Caption = "Request Could Not Be Sent"
'Request returned errors
ElseIf Not (response.SelectSingleNode
("GetSuggestedCategoriesResponse/Errors") Is Nothing) Then
Dim errorMsg As String
errorMsg = "ERROR: " & response.SelectSingleNode
("GetSuggestedCategoriesResponse/Errors/ErrorCode").Text & " - " & _
response.SelectSingleNode
("GetSuggestedCategoriesResponse/Errors/ShortMessage").Text
If Not (response.SelectSingleNode
("GetSuggestedCategoriesResponse/Errors/LongMessage") Is Nothing) Then
errorMsg = errorMsg & vbCrLf &
response.SelectSingleNode("GetSuggestedCategoriesResponse/Errors/
LongMessage").Text
End If
'lblResponse.Caption = errorMsg
'Request was Successful!
Else
'Display the results
' result = "COUNT: " & response.SelectSingleNode
("GetSuggestedCategoriesResponse/CategoryCount").Text
result = result & vbCrLf & vbCrLf
Dim n, cn As IXMLDOMNode ' node and childnode
Dim Highest As Single
Dim HicatItem As String
Dim catID As String
Dim catName As String
Dim catItem As String
'go through each suggestedcategory
For Each n In response.SelectSingleNode
("GetSuggestedCategoriesResponse/SuggestedCategoryArray").ChildNodes
If n.nodeName = "SuggestedCategory" Then
' Dim catName, catID, catItems As String
catID = n.SelectSingleNode("Category/
CategoryID").Text
catName = n.SelectSingleNode("Category/
CategoryName").Text
catItems = n.SelectSingleNode
("PercentItemFound").Text
'output the suggested category
If CSng(catItems > Highest) Then
Highest = CSng(catItems)
catID = n.SelectSingleNode("Category/
CategoryID").Text
catName = n.SelectSingleNode("Category/
CategoryName").Text
HicatItem = catItems
'result = catName & " (" & catID & ")
- " & HicatItem & "%" & vbCrLf
result = catID & "|" & catName 'result
& catName & " (" & catID & ") - " & catItems & "%" & vbCrLf
End If
End If
Next
MsgBox result
'lblResponse.Caption = result
End If
'End If
End Sub