Makro za web queries

[ Leovic @ 09.08.2010. 14:39 ] @

Molim pomoć!

Excel daje mogućnost skidanja podataka sa interneta na sledeći način:

Web queries - To use a Web query to retrieve data over the Internet, you must first create a Web query and retrieve the data into Excel. To create a Web query, point to Import External Data on the Data menu, and then click New Web Query.

Mene zanima sledeće: da li je moguće napraviti makro koji će automatski menjati prethodno definisane URL adrese?

Primer: u polju A1 imam URL adresu (ili njen promenljivi deo); u B1 treba da dobijem podatak koji je skinut sa web stranice čija je adresa u A1. Source web stranice ima samo jedan red teksta sa oko tridesetak karaktera, tako da svi podaci staju u jednu excel ćeliju. Kada se radi ručno, jedan po jedan web query, sve je OK.
Inače, sama URL adresa je takve strukture da se promenljivi deo nalazi u sredini kompletne adrese. Kolona A (promenljivi srting iz URL adrese) je ulaz, kolona B (tekst sa odovarajuće stranice) bi treblo da bude rešenje.

1 promenljivi_string_1 Tekst veb stranice broj 1
2 promenljivi_string_2 Tekst veb stranice broj 2
3 promenljivi_string_3 Tekst veb stranice broj 3
4 promenljivi_string_4 Tekst veb stranice broj 4
5 promenljivi_string_5 Tekst veb stranice broj 5
6 promenljivi_string_6 Tekst veb stranice broj 6
7 promenljivi_string_7 Tekst veb stranice broj 7
8 promenljivi_string_8 Tekst veb stranice broj 8

Pokušao sam da napravim VB makro, ali ne radi. Molim vas ako neko može da ispravi ovaj makro, ili da napravi novi.

Code:

Sub Macro1()

Dim sTxt As String

   For m = 1 To 1000
        sTxt = Cells(m, "A").Value

    strConnectString = "URL;http://www.nepromenljivi_deo_URL_adrese" & sTxt & "drugi_deo_nepromenljive_URL_adrese"
' On the Workspace worksheet, clear all existing query tables
        For Each QT In ActiveSheet.QueryTables
            QT.Delete
        Next QT

        Range("B1").Select

    .FieldNames = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlSpecifiedTables
            .WebFormatting = xlWebFormattingAll
            .WebTables = True
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = True
            .WebDisableDateRecognition = True
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With

Next m
End Sub

[ FOX028 @ 10.08.2010. 07:41 ] @

evo ovaj makro sam ja napravio kod mene, pogledaj pa ga preuredi za sebe

Sub Macro1()
Dim strURL As String

For i = 1 To 2
strURL = Sheets("Sheet3").Cells(i, 1)
With ActiveSheet.QueryTables.Add(Connection:="URL;" & strURL, _
Destination:=Range("A4"))
.Name = strURL
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Next i
End Sub

_{[Ovu poruku je menjao FOX028 dana 10.08.2010. u 09:05 GMT+1]}

[ Leovic @ 10.08.2010. 07:48 ] @

Molim te pokušaj ponovo da dodaš code.

[ FOX028 @ 10.08.2010. 08:06 ] @

dodato

[ Leovic @ 12.08.2010. 08:57 ] @

FOX028 hvala na pomoći ali ne uspevam i dalje da prilagodim makro. Bilo šta da promenim u tvom makrou, daje mi rezultate samo za dve URL adrese. I ta dva rezltata postavlja po vrsti, ne po koloni, npr. u A4 i B4. A ulazne URL-ove koji su bili u koloni A, premešta u kolonu B.
Ako napravim veću izmenu makroa, javlja mi: "run-time error 1004".
Ima li neko da može da pomogne? Bio bih mu zahvalan!

[ FOX028 @ 12.08.2010. 09:44 ] @

dva rezultata ti daje zato sto je postavljena petlja

For i=1 to 2

umesto 2 stavi koliko ti je potrebno, a mozes koristiti i Do petlju za to koja bi radila dokle god ima URL adresa

[ Leovic @ 12.08.2010. 11:05 ] @

Kada promenim broj 2 na neki veći, javlja mi "run time error 1004" ali ipak izvrši komandu. Jedino što i dalje prikazuje samo prva dva rezultata. Pretpostavljam da je rešenje jednostavno, ali nisam programer, ne mogu da "provalim" šta treba da izmenim.

[ Leovic @ 13.08.2010. 10:19 ] @

I dalje mi je potrebna pomoć!

Nekako sam došao do ovog code:

Code:

Sub Macro1()
Dim strURL As String

For i = 1 To 250
strURL = Sheets("Sheet1").Cells(i, 1)
With ActiveSheet.QueryTables.Add(Connection:="URL;" & strURL, _
Destination:=Range("b1"))
.Name = strURL
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Next i

End Sub

On daje rezultate ali je problem u lokaciji (destinaciji) rezultata.

Ulaz je kolona A sa URL-ovima od A1 do A250. Prinuđen sam da ograničim broj ulaznih URL-ova na 250 upravo zbog horizontalnog prikazivanja rezultata. Izlaz je od B1 do IQ1. Dakle, rezultati se prikazuju horizontalno, po prvoj vrsti, umesto vertikalno, po koloni B. Pri tome, svaki rezultat se prvo upisuje u cell B1, pa se onda pomera u desno. I sva polja koja su prethodno upisana pomeraju se za po jedno polje u desno da bi se nov rezultat upisao u B1. Kada se proces završi, u cell B1 je rešenje za URL iz cell A250 a u cell IQ1 je rešenje za URL iz A1.

Da li neko može da mi pomogne i da ispravi code?

Potrebno je da rezultati odgovaraju ulaznim URL-ovima:

Rezultat URL-a iz A1 da bude u B1
Rezultat URL-a iz A2 da bude u B2
Rezultat URL-a iz A3 da bude u B3
...
...
itd

Please help!

[ Jpeca @ 13.08.2010. 17:57 ] @

Za destination umesto Range("B1") stavi

Code:
Destination:= Range("A1").Offset(ColumnOffset:= i)

[ Leovic @ 13.08.2010. 21:53 ] @

Hvala puno Peco!

Jedino što umesto ColumnOffset treba staviti rowOffset .

Code:

Sub Macro1()
Dim strURL As String

For i = 1 To 1000
strURL = Sheets("Sheet1").Cells(i, 1)
With ActiveSheet.QueryTables.Add(Connection:="URL;" & strURL, _
Destination:=Range("B1").Offset(rowOffset:=i))
.Name = strURL
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False

End With
Next i

End Sub

Rezultati se dobijaju u koloni B za jednu ćeliju smaknuti u odnosu na kolonu A. Na primer, rezultat iz A1 je u B2, rezultat iz A2 je u B3...
Ali nije nikakav problem podići kompletnu kolonu sa rezultatima za jednu ćeliju na gore.
Bitno je da su rezultati u vertikali i da nemam ograničenje od 250 query-ja što je bio slučaj kod horizontalnog prikazivanja rezultata.

Zahvaljujem i FOX028 koji je postavio prvi code.

[ Jpeca @ 13.08.2010. 22:07 ] @

Izvini nisam pažljivo čitao, pa sam mislio da rezultate hoćeš jedno pored drugog umesto jedno ispod drugog. Da ti ne bude "smaknuto" za jednu ćeliju jednostavno umesto i stavi i-1

Code:
Destination:=Range("B1").Offset(rowOffset:=i-1)