वाक्यविन्यास त्रुटि के कारण VBA कोड काम नहीं कर रहा है

Question

मैं VBA में नया हूं। यहाँ मेरा उद्देश्य एक URL के द्वारा दिए गए स्टीम आइटम की सबसे कम कीमत दिखाने के लिए एक फंक्शन बनाना है।

यहाँ मैश-अप कोड है जो मैंने अब तक एक साथ रखा है। हालाँकि, सिंटैक्स त्रुटि के साथ एक समस्या है।

एक उदाहरण URL है http://steamcommunity.com/market/listings/440/Genuine%20Ap-Sap

मैं एक सेल में प्रदर्शित होने के लिए पेज पर सबसे कम कीमत प्राप्त करना चाहता हूं। पृष्ठ का HTML इस तरह है। मैं इसे सबसे कम कीमत प्राप्त करना चाहता हूं, वर्तमान में यह 9.89 है। मैं चाहता हूं कि यह शुल्क के साथ बाजार लिस्टिंग मूल्य दिखाए।

 <span class="market_listing_price market_listing_price_with_fee">
                    S&#36;9.89              </span>
                <span class="market_listing_price market_listing_price_without_fee">
                    S&#36;8.60              </span>

मेरा VBA कोड निम्न है (कुछ सिंटैक्स त्रुटि है)

Sub Retrieveprice() ' in the references section, enable 1) Microsoft Internet Controls, and 2) Microsoft HTML Object Library

Dim x As Long, y As Long Dim htmlText As Object

Set htmlText = CreateObject("htmlFile")

With CreateObject("msxml2.xmlhttp")
    .Open "GET", steamurl, False    ' save the URL in name manager as steamurl
    ' an example URL would be http://steamcommunity.com/market/listings/440/Genuine%20Ap-Sap
    .send
    htmlText.body.innerHTML = .responsetext End With

lStartPos = InStr(1, .responsetext, "<span class=CHR(34)market_listing_price market_listing_price_with_feeCHR(34)"> ") 
lEndPos = lStartPos + 12   'haven't counted the exact number yet, want to retrieve price
TextIWant = Mid$(.responsetext, lStartPos, lEndPos - lStartPos)   

Workbook.Worksheets.Add 
ActiveSheet.Range("A1").Value = TextIWant  

End Sub

आखिरकार अगर मैं इसे हल कर सकता हूं, तो मैं इसे एक फ़ंक्शन में बदलना चाहता हूं, ताकि मेरे पास सेल रिट = रिट्रीवप्राइस (URL) हो और यह URL पर स्टीम आइटम की सबसे कम कीमत वापस कर सके।

क्या कोई मुझे बता सकता है कि इस कोड को कैसे ठीक किया जाए और इसे फ़ंक्शन में बदल दिया जाए? वास्तव में इसकी सराहना करेंगे।

Comments

FYI करें, lStartPos के लिए विवरण समाप्त होना चाहिए fee" + CHR(34) + "> ")।

— LDC3

Answer 1

आमतौर पर, .responseText के रूप में पार्स किया जाता है HTML दस्तावेज़ लेकिन इसे कड़े कार्यों के साथ भी संभाला जा सकता है। आप आराम से लग रहे थे Mid, Instr, आदि तो मैं उस रास्ते पर रहा। यह एक नई वर्कशीट शुरू नहीं करता है; केवल वर्तमान में लिखते हैं ताकि आप मैक्रो को चलाने से पहले एक नए रिक्त वर्कशीट पर शुरू करें।

Sub Retrieveprice() ' in the references section, enable 1) Microsoft Internet Controls, and 2) Microsoft HTML Object Library

    Dim x As Long, y As Long, steamUrl As String, steamTxt As String, spanTxt As String, spanEndTxt As String

    steamUrl = "http://steamcommunity.com/market/listings/440/Genuine%20Ap-Sap"

    With CreateObject("msxml2.xmlhttp")
        .Open "GET", steamUrl, False
        .send
        steamTxt = .responsetext
    End With

    spanTxt = "<span class=""market_listing_price market_listing_price_with_fee"">"
    spanEndTxt = "</span>"
    x = InStr(1, steamTxt, spanTxt)
    With ActiveSheet
        Do While CBool(x)
            y = InStr(x, steamTxt, spanEndTxt)
            .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = _
              Application.Trim(Replace(Mid(steamTxt, x, (y - x) + Len(spanEndTxt)), Chr(10), vbNullString))
            x = InStr(y, steamTxt, spanTxt)
        Loop
    End With

End Sub

आप निम्न के समान परिणाम की उम्मीद कर सकते हैं।

जहाँ तक मैं आपके द्वारा प्रदान की गई जानकारी के साथ जा सकता हूं, लेकिन यह आपको सही दिशा में एक कुहनी से हलका धक्का दे सकता है।