Žiniatinklio užklausų ir ciklo naudojimas norint atsisiųsti 4000 duomenų bazių įrašų iš 4000 tinklalapių - „Excel“ patarimai

Turinys

Vieną dieną iš Janos gavau transliuojamą elektroninį laišką PMA. Ji perdavė puikią Gary Gagliardi idėją iš „Clearbridge Publishing“. Gary paminėjo, kad kai kurios paieškos sistemos priskiria puslapio reitingą pagal tai, kiek kitų svetainių nukreipia į puslapį. Jis siūlė, kad jei visi 4000 PMA narių susietų su visais 4000 kitų PMA narių, tai padidintų visus mūsų reitingus. Jan manė, kad tai puiki idėja, ir pasakė, kad visi PMA narių interneto adresai yra išvardyti dabartinėje PMA svetainėje narių srityje.

Asmeniškai manau, kad „nuorodų skaičiaus“ teorija yra šiek tiek mitas, tačiau norėjau ją išbandyti norėdamas padėti.

Taigi apsilankiau PMA narių srityje, kur greitai sužinojau, kad yra ne vienas narių sąrašas, o iš tikrųjų 27 narių sąrašai.

Lankiausi PMA narių rajone.

Spustelėjęs „A“ puslapį pamačiau, kad jis dar blogesnis. Kiekviena nuoroda šiame puslapyje nenukreipė į nario svetainę. Kiekviena nuoroda veda į atskirą puslapį PMA-online su nario svetaine.

Nuorodos tinklalapyje.

Tai reikštų, kad turėčiau aplankyti tūkstančius tinklalapių, kad galėčiau sudaryti narių sąrašą. Tai aiškiai būtų beprotiškas pasiūlymas.

Laimei, esu „Microsoft Excel“ VBA ir makrokomandų bendraautorius. Man kilo klausimas, ar galėčiau pritaikyti knygos kodą, kad išspręstų narių URL išskleidimo iš tūkstančių susietų puslapių problemą.

Knygos 14 skyrius yra apie „Excel“ naudojimą skaitant iš interneto ir rašant į jį. 335 puslapyje radau kodą, kuris galėtų sukurti žiniatinklio užklausą skrendant.

Pirmasis žingsnis buvo išsiaiškinti, ar galiu pritaikyti knygos kodą, kad galėčiau pateikti 27 žiniatinklio užklausas - po vieną kiekvienai abėcėlės raidei ir skaičiui 1. Tai man suteiktų kelis visų nuorodų sąrašus 26 abėcėlės puslapių sąrašai.

Kiekvieno puslapio URL yra panašus į http://www.pma-online.org/scripts/showmemlist.cfm?letter=A. Aš paėmiau kodą iš 335 puslapio ir šiek tiek jį pritaikiau, kad atlikčiau 27 žiniatinklio užklausas.

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

Pirmiau pateiktame kode buvo pritaikyti keturi elementai.

  • Pirmiausia turėjau sukurti teisingą URL. Tai buvo pasiekta pridėjus tinkamą raidę prie URL eilutės pabaigos.
  • Antra, pakeičiau kodą, kad kiekviena užklausa būtų vykdoma naujame darbaknygės darbalapyje.
  • Trečia, knygos kodas sugriebė 20-ą lentelę iš tinklalapio. Įrašydamas makrokomandą, traukiančią lentelę iš PMA, sužinojau, kad man reikia 7-osios lentelės tinklalapyje.
  • Ketvirta, paleidęs makrokomandą, nusivyliau pamatęs, kad gavau leidėjų vardus, bet ne hipersaitus. Nurodytas knygos kodas .WebFormatting: = xlFormattingNone. Naudodamasis VBA pagalba supratau, kad jei pakeisčiau į .WebFormatting: = xlFormattingAll, gausiu tikras hipersaitus.

Paleidęs šią pirmąją makrokomandą turėjau 27 darbalapius, kurių kiekviename buvo keletas hipersaitų, kurie atrodė taip:

Ištrauktos nuorodos su hipersaitais „Excel“.

Kitas žingsnis buvo ištraukti hipersaitinį adresą iš visų 27 darbalapių hipersaitų. Knygoje to nėra, tačiau „Excel“ yra hipersaito objektas. Objektas turi ypatybę .Address, kuri grąžins tinklalapį „PMA-Online“ su to leidėjo URL.

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

Paleidęs šią makrokomandą, pagaliau sužinojau, kad PMA svetainėje yra 4119 atskiri tinklalapiai. Džiaugiuosi, kad nebandžiau aplankyti kiekvienos svetainės po vieną!

Kitas mano tikslas buvo sukurti internetinę užklausą, skirtą aplankyti kiekvieną iš 4119 atskirų tinklalapių. Aš užfiksavau makrokomandą, grąžinančią vieną iš atskirų leidėjų puslapių, kad sužinotų, jog noriu 5 lentelės iš kiekvieno puslapio. Aš mačiau, kad leidėjo vardas buvo grąžintas kaip penkta lentelės eilutė. Daugeliu atvejų svetainė buvo grąžinta kaip 13 eilutė. Tačiau sužinojau, kad kai kuriais atvejais, jei gatvės adresas buvo 3 eilutės, o ne 2, svetainės URL iš tikrųjų buvo 14 eilutėje. Jei jie turėjo 3 telefonus, o ne 2, svetainė buvo nustumta žemyn kita eilute. Makrokomanda turėtų būti pakankamai lanksti, kad galėtumėte ieškoti galbūt nuo 13 iki 18 eilutės, kad rastumėte langelį, kuris pradėjo WWW :.

Buvo dar viena dilema. Knygos kodas leidžia internetinę užklausą atnaujinti fone. Daugeliu atvejų aš iš tikrųjų stebėčiau, kaip užklausa baigta, kai makrokomanda bus baigta. Mano pradinė mintis buvo leisti kiekvienam leidėjui 40 eilučių ir kiekviename puslapyje sukurti visas 4100 užklausų. Tam būtų reikėję 80 000 skaičiuoklės eilučių ir daug atminties. Programoje „Excel 2002“ eksperimentavau keisdamas „BackgroundRefresh“ į „False“. VBA gerai ištraukė informaciją į darbalapį, kol nebus tęsiama makrokomanda. Tai leido sukurti užklausą, atnaujinti užklausą, išsaugoti reikšmes duomenų bazėje, tada ištrinti užklausą. Naudojant šį metodą, darbalapyje niekada nebuvo daugiau nei vienos užklausos vienu metu.

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

Ši užklausa užtruko daugiau nei valandą. Galų gale, jis dirbo apsilankydamas daugiau nei 4000 tinklalapių. Jis veikė be kliūčių ir nesudaužė kompiuterio ar „Excel“.

Tada turėjau gražią „Excel“ duomenų bazę su „Publisher“ vardu A stulpelyje, o svetainę - B stulpelyje. Rūšiavusi pagal svetainę B stulpelyje, radau, kad daugiau nei 1000 leidėjų nepateikė interneto svetainės. Jų įrašas B stulpelyje buvo tuščias URL. Aš rūšiavau ir ištryniau šias eilutes.

Be to, B stulpelyje nurodytose svetainėse prieš kiekvieną URL buvo „WWW:“. Aš naudoju Redaguoti> Pakeisti, kad pakeisčiau kiekvieną WWW atvejį: (su tarpu po jo) į nieką. Skaičiuoklėje turėjau gražų 2339 leidėjų sąrašą.

Leidėjų sąrašas skaičiuoklėje.

Paskutinis žingsnis buvo išrašyti tekstinį failą, kurį būtų galima nukopijuoti ir įklijuoti į bet kurio nario svetainę. Ši makrokomanda (pritaikyta pagal kodą 345 puslapyje) puikiai tvarkė šią užduotį.

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

Rezultatas buvo teksto failas su daugiau nei 2000 leidėjų pavadinimu ir URL.

Visas minėtas kodas buvo pritaikytas iš knygos. Kai pradėjau, buvau tarsi atlikęs vienkartinę programą, kurios neįsivaizdavau reguliariai. Tačiau dabar galiu kas mėnesį grįžti į PMA svetainę, norėdamas gauti atnaujintus URL sąrašus.

Visus minėtus veiksmus būtų galima sudėti į vieną makrokomandą.

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

„Excel“ ir VBA suteikė greitą alternatyvą individualiam apsilankymui tūkstančiuose tinklalapių. Teoriškai PMA turėjo sugebėti pateikti užklausą savo duomenų bazėje ir pateikti šią informaciją kur kas greičiau nei naudojant šį metodą. Tačiau kartais susiduriate su nebendradarbiaujančiu asmeniu arba galbūt nežinančiu, kaip gauti duomenų iš duomenų bazės, kurią kažkas kitas jiems parašė. Šiuo atveju šiek tiek VBA makrokodo išsprendė mūsų problemą.

Įdomios straipsniai...