I have created a sub in VBA which checks if I have been undercut on an online bookstore. The problem is, many authors and titles have accented characters in them, which, as far as I have experienced, I cant but into a querytable. For example the charactera á,é,ö become strange symbols like # or $ when I try to load a webpage.
I am attaching the code I have so far:
For i = 1 To Sorok
Nev(i) = Ekezet(Sheets(AdatokLap).Cells(i + 1, 4)
KonyvCim(i) = Ekezet(Sheets(AdatokLap).Cells(i + 1, 5)
ConnectString = "URL;http://bookline.hu/search/search.action? inner=true&searchfield=" & Nev(i) & " " & KonyvCim(i) & "&tab=bookline.hu%2Foldbook"
Set qt = Sheets(QueryLap).QueryTables.Add(Connection:=ConnectString, Destination:=Cells(1, 1))
With qt
.Name = "MyName"
.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
I have written a function, called Ekezet(), which removes all accented characters from a string. Is there any way I don't have to remove accented characters and still run a web query?
Related
I want to scrap data from a website using Excel and I have a problem that each extraction of data is inserted into new sheet while I want the new scraped data to be inserted bellow the previous data , first I have a sheet that has the links of all webpages that from the data are scraped .. my VBA codes are :
Sub adds()
For x = 1 To 316
Worksheets("Sheet3").Select
Worksheets("Sheet3").Activate
mystr = " "
mystr = Cells(x, 1)
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = x
With ActiveSheet.QueryTables.Add(Connection:=mystr, Destination:=Range("$A$1"))
'CommandType = 0
.Name = "?q=ÍäÇä&daleel=mtn&do=search&page=2"
.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 x
End Sub
Extracting tabular form data from multiple webpages into an excel using VBA macros..!! Currently iam using below link but i could able to only one webpage in the code..i have list of ulr's to get data from...and it has to come in vertical..!! please suggest me.. :)
Sub INDEXdata()
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://recorder.maricopa.gov/recdocdata/GetRecDataDetail.aspx?rec=19770000007" _
, Destination:=Range("$A$1"))
.Name = "rec=19770000006"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2,3"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
OK, I don't know how much programming background you have, and I also don't know what parts of the code you posted are specific to that one source url and target location.
But, something like this might work. I made the assumption that the url, the destination, and the name would change for each page you wanted to pull from.
What I did was take the part of the code that looked like it would be true for all of the source pages and destinations, and put that in its own parameterized subroutine. The original routine IndexData just specifies the URL and the destination, and the name, for each copy operation.
Sub IndexData()
GetData("http://recorder.maricopa.gov/recdocdata/GetRecDataDetail.aspx?rec=19770000007" , _
"$A$1", _
"rec=19770000006")
GetData("http://somewhereelse.com/somedata.aspx?rec=12345", _
"$A$2", _
"rec=12345")
GetData("http://anotherurl.com/etc", _
"$A$3", _
"something")
End
Sub GetData(url as string, destination as string, name as string)
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & url , Destination:=Range(destination))
.Name = name
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2,3"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
I'm doing a web scrape in VBA (see code below) to btc-e.com to fetch prices of some Cryptocurrency. When to it manually by going to data tab and then clicking on from web It works fine, but When I do it in the Macro I only get back "please wait..."
The page displays "please wait..." as it loads and the macro assumes that is the entire page.
I have been looking for a way to make the macro wait for the full page load and cant find anything.
Any help would be appreciated.
Thanks
With ActiveSheet.QueryTables.Add(connection:="URL;https://btc-e.com", _
Destination:=Range("$A$1"))
.Name = "btc-e"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False ' was 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 ' True ' was false
.WebDisableRedirections = False 'True ' was false
.Refresh BackgroundQuery:=False
End With
You have to choose a specific table or area of the page you want scraped, otherwise it won't work. The reason is that you are automatically forwarded from the page you are trying to scrape to the page you can actually scrape.
When I chose to scrape the Sell Orders, this is the code I got from the macro recorder:
With ActiveSheet.QueryTables.Add(Connection:="URL;https://btc-e.com", _
Destination:=Range("$B$2"))
.Name = "btc-e"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "3"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
As you can see it takes the attribute ".WebTables" which chooses a specific portion of the site. You can choose the portion you want by activating the macro recorder, scraping it through the normal way, choosing the area you want and then looking at the value of WebTables in the resulting code.
Hope this helps!
I recorded a macro and edited it. It scrapes particular data from webpages (found on links) and display them on separate pages.
I want to use the data (VLOOKUP) but the data is on different pages which makes it hard to get an accurate formula.
Every week I change the second line of the code
For x = 1 To 20
to
For x = 21 to ....
for example, because new links/data come out every week.
How do I find the last line to add the next lot of data below that?
Sub Update()
For x = 1 To 20
Worksheets("Links").Select
Worksheets("Links").Activate
mystr = Cells(x, 8)
mystr2 = Cells(x, 15)
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = x
With ActiveSheet.QueryTables.Add(Connection:=mystr, Destination:=Range("$K$1"))
.Name = "report2_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:=mystr2, Destination:=Range("$A$1"))
.Name = "report6_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Next x
End Sub
instead of
for x = 1 to 20
do
for x = Range("A" & Rows.Count).End(xlUp).Row to Range("A" & Rows.Count).End(xlUp).Row-20 step -1
which will find the last cell used in Column A and subtract 20 rows from it and iterate backwars
I am trying to scrape a large volume of data using my rather basic excel skills. I am using this as a guide (http://www.familycomputerclub.com/scrpae-pull-data-from-websites-into-excel.html), and have got it to work for my data, but now trying to amend the code to meet my requirements.
I have about 10,000 Roll numbers listed in columns, and need to scrape the data from this site (last 10 digits being the roll numbers): http://www.winnipegassessment.com/AsmtPub/english/propertydetails/details.aspx?pgLang=EN&isRealtySearch=true&RollNumber=2011016000
Basically, rather than adding new worksheets for each page download (as per the guide I have been using above), I would like to keep all the new data on the master page, simply transposing the it in to the row with its corresponding roll number (perhaps from the C column).
My code is as follows:
Sub adds()
For x = 1 To 5
Worksheets("RollNo").Select
Worksheets("RollNo").Activate
mystr = "URL;http://www.winnipegassessment.com/AsmtPub/english/propertydetails/details.aspx?pgLang=EN&isRealtySearch=true&RollNumber=2000416000.html"
mystr = Cells(x, 1)
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = x
With ActiveSheet.QueryTables.Add(Connection:=mystr, Destination:=Range("$A$2"))
'CommandType = 0
.Name = "2000416000_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2,6,7" '---> Note: many tables have been selected for import from the website
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Next x
End Sub
Sub ProcessAll()
Dim c As Range, shtData As Worksheet
Set shtData = Worksheets("WebQuery")
For Each c In Worksheets("RollNo").Range("A1:A5").Cells
If c.Value <> "" Then
FetchData c.Value
'move fetched data to the sheet
With c.EntireRow
.Cells(2).Value = shtData.Range("A2").Value
'etc....
End With
End If
Next c
End Sub
Sub FetchData(rollNo)
Const BASE_URL As String = "URL;http://www.winnipegassessment.com/AsmtPub/english/" & _
"propertydetails/details.aspx?pgLang=EN&isRealtySearch=true&RollNumber="
Dim qt As QueryTable
With Worksheets("WebQuery")
On Error Resume Next
.QueryTables(1).Delete
On Error GoTo 0
.Cells.Clear
With .QueryTables.Add(Connection:=BASE_URL & rollNo, Destination:=.Range("A2"))
.Name = "2000416000_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2,6,7"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End With
End Sub