एक दिन, मुझे पीएमए में जनवरी से एक प्रसारण ई-मेल मिला। वह क्लियरब्रिज पब्लिशिंग के गैरी गागलियार्डी के एक महान विचार के साथ गुजर रही थी। गैरी ने उल्लेख किया कि कुछ खोज इंजन पृष्ठ पर एक पेज रैंक प्रदान करते हैं जो इस आधार पर होता है कि पृष्ठ की अन्य साइटें कितनी लिंक करती हैं। उनका सुझाव था कि यदि पीएमए के सभी 4000 सदस्य पीएमए के सभी 4000 अन्य सदस्यों से जुड़ेंगे, तो यह हमारी सभी रैंकिंग को बढ़ावा देगा। जान ने सोचा कि यह एक महान विचार है और कहा गया है कि सभी पीएमए सदस्य वेब पते सदस्यों की वर्तमान पीएमए वेबसाइट पर सूचीबद्ध हैं।
व्यक्तिगत रूप से, मुझे लगता है कि "लिंक की संख्या" सिद्धांत थोड़ा मिथक है, लेकिन मैं इसे मदद करने के लिए एक कोशिश देने के लिए तैयार था।
इसलिए, मैंने पीएमए सदस्यों के क्षेत्र का दौरा किया, जहां मुझे जल्दी पता चला कि सदस्यों की एक भी सूची नहीं थी, लेकिन वास्तव में सदस्यों की सूची 27 थी।
जैसा कि मैंने "ए" पृष्ठ पर क्लिक किया, मैंने देखा कि यह और भी खराब था। इस पृष्ठ के प्रत्येक लिंक में सदस्य की वेबसाइट नहीं थी। यहां प्रत्येक लिंक सदस्य की वेबसाइट के साथ पीएमए-ऑनलाइन पर एक अलग पृष्ठ पर ले जाता है।
इसका मतलब यह होगा कि सदस्यों की सूची को संकलित करने के लिए मुझे हजारों वेब पृष्ठों पर जाना होगा। यह स्पष्ट रूप से एक पागल प्रस्ताव होगा।
सौभाग्य से, मैं Microsoft Excel के लिए VBA और मैक्रोज़ का सह-लेखक हूं। मुझे आश्चर्य हुआ कि क्या मैं हजारों जुड़े पृष्ठों से सदस्य URL निकालने की समस्या को हल करने के लिए पुस्तक से कोड को अनुकूलित कर सकता हूं।
पुस्तक का अध्याय 14 वेब से पढ़ने और लिखने के लिए एक्सेल का उपयोग करने के बारे में है। पृष्ठ 335 पर, मुझे कोड मिला जो मक्खी पर एक वेब क्वेरी बना सकता था।
पहला कदम यह देखना था कि क्या मैं 27 वेब प्रश्नों का उत्पादन करने में सक्षम होने के लिए पुस्तक में कोड को अनुकूलित कर सकता हूं - वर्णमाला के प्रत्येक अक्षर और संख्या 1 के लिए। यह मुझे सभी लिंक की कई सूचियों को प्रदान करेगा। 26 वर्णमाला पृष्ठ लिस्टिंग।
प्रत्येक पृष्ठ में http://www.pma-online.org/scripts/showmemlist.cfm?letter=A के समान URL है। मैंने पृष्ठ 335 से कोड लिया और 27 वेब क्वेरीज़ को करने के लिए इसे थोड़ा अनुकूलित किया।
Sub CreateNewQuery() ' Page 335 Dim WSD As Worksheet Dim WSW As Worksheet Dim QT As QueryTable For m = 1 To 27 Select Case m Case 27 MyStr = "1" Case Else MyStr = Chr(64 + m) End Select MyName = "Query" & m ConnectString = "URL;http://www.pma-online.org/scripts/showmemlist.cfm?letter=" & MyStr ThisWorkbook.Worksheets.Add ActiveSheet.Name = m ' On the Workspace worksheet, clear all existing query tables For Each QT In ActiveSheet.QueryTables QT.Delete Next QT ' Define a new Web Query Set QT = ActiveSheet.QueryTables.Add(Connection:=ConnectString, Destination:=Range("A1")) With QT .Name = MyName .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingAll .WebTables = "7" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False End With ' Refresh the Query QT.Refresh BackgroundQuery:=True Next m End Subचार आइटम थे जो उपरोक्त कोड में अनुकूलित किए गए थे।
- सबसे पहले, मुझे सही URL बनाना था। यह URL स्ट्रिंग के अंत में उचित अक्षर जोड़कर प्राप्त किया गया था।
- दूसरा, मैंने कार्यपुस्तिका में एक नई वर्कशीट पर प्रत्येक क्वेरी को चलाने के लिए कोड को संशोधित किया।
- तीसरा, पुस्तक का कोड वेब पेज से 20 वीं तालिका को हथियाने वाला था। PMA से तालिका में एक मैक्रो पुलिंग रिकॉर्ड करके, मुझे पता चला कि मुझे वेब पेज पर 7 वीं तालिका की आवश्यकता है।
- चौथा, मैक्रो चलाने के बाद, मुझे यह देखकर निराशा हुई कि मुझे प्रकाशकों के नाम मिल रहे थे, लेकिन हाइपरलिंक नहीं। पुस्तक में कोड निर्दिष्ट किया गया है। WebFormatting: = xlFormattingNone। VBA सहायता का उपयोग करते हुए, मुझे लगा कि अगर मैं बदल गया हूँ। WebFormatting: = xlFormattingAll, मुझे वास्तविक हाइपरलिंक मिलेंगे।
इस पहली मैक्रो को चलाने के बाद, मेरे पास 27 वर्कशीट थीं, जिनमें से प्रत्येक हाइपरलिंक्स की एक श्रृंखला थी जो इस तरह दिखती थी:
अगला कदम 27 वर्कशीट पर प्रत्येक हाइपरलिंक से हाइपरलिंक किए गए पते को निकालना था। यह पुस्तक में नहीं है, लेकिन एक्सेल में एक हाइपरलिंक ऑब्जेक्ट है। ऑब्जेक्ट में एक। संपत्ति है जो उस प्रकाशक के URL के साथ PMA-Online के भीतर वेबपृष्ठ लौटाएगा।
Sub GetEmAll() NextRow = 1 Dim WSD As Worksheet Dim WS As Worksheet Set WSD = Worksheets("Sheet1") For Each WS In ActiveWorkbook.Worksheets If Not WS.Name = "Sheet1" Then For Each cll In WS.UsedRange.Cells For Each hl In cll.Hyperlinks WSD.Cells(NextRow, 1).Value = hl.Address NextRow = NextRow + 1 Next hl Next cll End If Next WS End Subइस मैक्रो को चलाने के बाद, मुझे अंततः पता चला कि पीएमए साइट पर 4119 व्यक्तिगत वेबपेज थे। मुझे खुशी है कि मैंने एक बार में प्रत्येक व्यक्तिगत साइट पर जाने की कोशिश नहीं की!
मेरा अगला लक्ष्य 4119 व्यक्तिगत वेब पेजों में से प्रत्येक पर जाने के लिए एक वेबक्वायरी का निर्माण करना था। मैंने यह जानने के लिए कि मैं प्रत्येक पृष्ठ से तालिका # 5 चाहता था, एक व्यक्तिगत प्रकाशक पृष्ठों में से एक को लौटाने वाला एक मैक्रो दर्ज किया। मैं देख सकता था कि प्रकाशक का नाम तालिका की पांचवीं पंक्ति के रूप में वापस आ गया था। ज्यादातर मामलों में, वेबसाइट को 13 वीं पंक्ति के रूप में वापस किया गया था। हालाँकि, मुझे पता चला कि कुछ मामलों में, यदि सड़क का पता 2 के बजाय 3 पंक्तियों का था, तो वेबसाइट URL वास्तव में पंक्ति 14 पर था। यदि उनके पास 2 के बजाय 3 टेलीफोन थे, तो वेबसाइट को दूसरी पंक्ति से नीचे धकेल दिया गया था। WWW: को शुरू करने वाले सेल को खोजने के लिए मैक्रो को शायद पंक्ति 13 से 18 तक खोजने के लिए पर्याप्त लचीला होना चाहिए।
एक और दुविधा थी। पुस्तक में कोड वेबकरी को पृष्ठभूमि में ताज़ा करने की अनुमति देता है। ज्यादातर मामलों में, मैं वास्तव में मैक्रो के खत्म होने के बाद क्वेरी को खत्म करूंगा। मेरा प्रारंभिक विचार प्रत्येक प्रकाशक के लिए 40 पंक्तियों की अनुमति देना था, और प्रत्येक पृष्ठ पर सभी 4100 प्रश्नों का निर्माण करना था। इसके लिए स्प्रेडशीट की 80,000 पंक्तियों और बहुत सारी मेमोरी की आवश्यकता होती है। Excel 2002 में, मैंने BackgroundRefresh को False में बदलने का प्रयोग किया। मैक्रो पर जाने से पहले VBA ने कार्यपत्रक में जानकारी खींचने का अच्छा काम किया। यह क्वेरी बनाने, क्वेरी को रीफ़्रेश करने, डेटाबेस को मान सहेजने, फिर क्वेरी को हटाने की अनुमति देता है। इस पद्धति का उपयोग करते हुए, वर्कशीट पर एक समय में एक से अधिक क्वेरी कभी नहीं होती थी।
Sub AllQuery() Dim WS As Worksheet Dim WD As Worksheet Set WD = Worksheets("database") Set WS = Worksheets("Sheet1") Dim QT As QueryTable WS.Activate OutCol = 8 OutRow = 1 FinalRow = WS.Cells(65536, 1).End(xlUp).Row For i = 2 To FinalRow ConnectString = "URL;" & WD.Cells(i, 12).Value Application.StatusBar = i ' Save after every 500 queries If i Mod 500 = 0 Then ThisWorkbook.Save End If MyName = "Query" & i ' Define a new Web Query Set QT = ActiveSheet.QueryTables.Add(Connection:=ConnectString, Destination:=WS.Cells(OutRow, OutCol)) With QT .Name = MyName .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = False .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "5" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False End With ' Refresh the Query QT.Refresh BackgroundQuery:=False ' Change from a live query to values WS.Cells(OutRow, OutCol).Resize(40, 2).Value = WS.Cells(OutRow, OutCol).Resize(40, 2).Value For Each QT In WS.QueryTables QT.Delete Next QT ' Copy to Database WD.Cells(i, 1).Value = WS.Cells(5, 8).Value For j = 13 To 20 CheckIt = WS.Cells(j, 8).Value If Left(CheckIt, 3) = "WWW" Then WD.Cells(i, 8).Value = CheckIt End If Next j Next i End Subइस क्वेरी को चलने में एक घंटे से अधिक समय लगा। आखिरकार, यह 4000 से अधिक वेब पृष्ठों पर जाने का काम कर रहा था। यह बिना किसी अड़चन के चलता था और कंप्यूटर या एक्सेल को क्रैश नहीं करता था।
मेरे पास कॉलम ए में प्रकाशक नाम और स्तंभ बी में वेबसाइट के साथ एक्सेल में एक अच्छा डेटाबेस था। कॉलम बी में वेबसाइट द्वारा सॉर्ट करने के बाद, मैंने पाया कि 1000 से अधिक प्रकाशकों ने एक वेब साइट को सूचीबद्ध नहीं किया था। कॉलम B में उनका प्रवेश एक रिक्त URL था। मैंने इन पंक्तियों को हल किया और हटा दिया।
साथ ही, कॉलम B में सूचीबद्ध वेबसाइटों में प्रत्येक URL से पहले "WWW:" था। मैंने WWW की प्रत्येक घटना को बदलने के लिए एक एडिट> रिप्लेस का उपयोग किया: (इसके बाद एक स्थान के साथ) कुछ भी नहीं करने के लिए। मेरे पास एक स्प्रेडशीट पर 2339 प्रकाशकों की एक अच्छी सूची थी।
अंतिम चरण एक पाठ फ़ाइल लिखना था जिसे किसी भी सदस्य की वेबसाइट में कॉपी और पेस्ट किया जा सके। निम्नलिखित मैक्रो (पृष्ठ 345 पर कोड से अनुकूलित) ने इस कार्य को अच्छी तरह से संभाला।
Sub WriteHTML() On Error Resume Next Kill "C:PMALinks.txt" On Error GoTo 0 Open "C:PMALinks.txt" For Output As #1 Print #1, "Visit the websites of our fellow PMA members:
" For i = 2 To 2340 MyStr = "
- " & Cells(i, 1).Value & "" Print #1, MyStr Next i Print #1, "
" Close #1 End Subपरिणाम 2000+ प्रकाशकों के नाम और URL के साथ एक पाठ फ़ाइल थी।
उपरोक्त सभी कोड को पुस्तक से रूपांतरित किया गया था। जब मैंने शुरुआत की थी, तो मैं सिर्फ एक बार के कार्यक्रम को करने की तरह था जिसे मैंने नियमित रूप से चलाने की कल्पना नहीं की थी। हालाँकि, मैं अब हर महीने पीएमए वेबसाइट पर वापस जा रहा इमेजिंग कर सकता हूं या फिर यूआरएल की अद्यतन सूची प्राप्त कर सकता हूं।
उपरोक्त सभी चरणों को एक ही मैक्रो में डालना संभव होगा।
Sub DoEverything() Dim WSW As Worksheet Dim WST As Worksheet Set WSW = Worksheets("Workspace") Set WST = Worksheets("Template") On Error Resume Next Kill "C:AutoLinks.txt" On Error GoTo 0 Open "C:PMALinks.txt" For Output As #1 Print #1, "Visit the websites of our fellow PMA members:
" For m = 1 To 27 Select Case m Case 27 MyStr = "1" Case Else MyStr = Chr(64 + m) End Select MyName = "Query" & m ConnectString = "URL;http://www.pma-online.org/scripts/showmemlist.cfm?letter=" & MyStr ' On the Workspace worksheet, clear all existing query tables For Each QT In WSW.QueryTables QT.Delete Next QT ' Define a new Web Query Set QT = WSW.QueryTables.Add(Connection:=ConnectString, Destination:=WSW.Range("A1")) With QT .Name = MyName .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingAll .WebTables = "7" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False End With ' Refresh the Query QT.Refresh BackgroundQuery:=False ' Next, loop through all of the hyperlinks in the resulting page For Each cll In WSW.UsedRange.Cells For Each hl In cll.Hyperlinks MyURL = hl.Address ' Build a web query on WST ConnectString = "URL;" & MyURL MyName = "Query" & NextRow ' Define a new Web Query Set QT = WST.QueryTables.Add(Connection:=ConnectString, Destination:=WST.Cells(1, 1)) With QT .Name = MyName .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = False .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "5" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False End With ' Refresh the Query QT.Refresh BackgroundQuery:=False ' Change from a live query to values WST.Cells(1, 1).Resize(40, 2).Value = WST.Cells(1, 1).Resize(40, 2).Value For Each QT In WS.QueryTables QT.Delete Next QT ' Find URL ThisPub = WS.Cells(5, 8).Value ThisURL = "WWW: http://" For j = 13 To 20 CheckIt = WS.Cells(j, 8).Value If Left(CheckIt, 3) = "WWW" Then ThisURL = CheckIt End If Next j If Not ThisURL = "WWW: http://" Then ' write a record to the .txt file MyStr = "
- " & ThisPub & "" Print #1, MyStr End If Next hl Next cll Next m Print #1, "
" Close #1 End Subएक्सेल और VBA ने व्यक्तिगत रूप से हजारों वेब पृष्ठों पर जाने का एक त्वरित विकल्प प्रदान किया। सिद्धांत रूप में, पीएमए को अपने डेटाबेस को क्वेरी करने और इस विधि का उपयोग करने की तुलना में कहीं अधिक तेज़ी से यह जानकारी प्रदान करने में सक्षम होना चाहिए था। हालाँकि, कभी-कभी आप किसी ऐसे व्यक्ति के साथ काम कर रहे होते हैं जो असहयोगी होता है या संभवतः यह नहीं जानता कि किसी डेटाबेस से डेटा कैसे प्राप्त किया जाए जो किसी और ने उनके लिए लिखा था। इस मामले में, VBA मैक्रो कोड के एक बिट ने हमारी समस्या को हल किया।
