i need to scrape with a VBA Macro the odds that are on this link:
Betexplorer link
Betexplorer example image
I have tried with this VBA code:
Public Sub Scraping_MatchQuote()
Worksheets("Foglio1").Select
urlBetExplorerMatch = "https://www.betexplorer.com/soccer/albania/superliga/kukesi-partizani/zHiqu2S9/"
Set http1 = CreateObject("MSXML2.XMLHTTP")
http1.Open "POST", urlBetExplorerMatch, False
http1.Send
While http1.READYSTATE <> 4
DoEvents
Wend
Text1 = http1.ResponseText
Sheets("Foglio1").Cells(1, 1) = Text1
End Sub
But on the output i cant see the part of the table with the odds that i want to scrape..
Can someone help me with a example of code ?
Related
Goal: Find headings in a document by their font and font size and put them into a spreadsheet.
All headings in my doc are formatted as Ariel, size 16. I want to do a find of the Word doc, select the matching range of text to the end of the line, then assign it to a variable so I can put it in a spreadsheet. I can do an advanced find and search for the font/size successfully, but can't get it to select the range of text or assign it to a variable.
Tried modifying the below from http://www.vbaexpress.com/forum/showthread.php?55726-find-replace-fonts-macro but couldn't figure out how to select and assign the found text to a variable. If I can get it assigned to the variable then I can take care of the rest to get it into a spreadsheet.
'A basic Word macro coded by Greg Maxey
Sub FindFont
Dim strHeading as string
Dim oChr As Range
For Each oChr In ActiveDocument.Range.Characters
If oChr.Font.Name = "Ariel" And oChr.Font.Size = "16" Then
strHeading = .selected
Next
lbl_Exit:
Exit Sub
End Sub
To get the current code working, you just need to amend strHeading = .selected to something like strHeading = strHeading & oChr & vbNewLine. You'll also need to add an End If statement after that line and probably amend "Ariel" to "Arial".
I think a better way to do this would be to use Word's Find method. Depending on how you are going to be inserting the data into the spreadsheet, you may also prefer to put each header that you find in a collection instead of a string, although you could easily delimit the string and then split it before transferring the data into the spreadsheet.
Just to give you some more ideas, I've put some sample code below.
Sub Demo()
Dim Find As Find
Dim Result As Collection
Set Find = ActiveDocument.Range.Find
With Find
.Font.Name = "Arial"
.Font.Size = 16
End With
Set Result = Execute(Find)
If Result.Count = 0 Then
MsgBox "No match found"
Exit Sub
Else
TransferToExcel Result
End If
End Sub
Function Execute(Find As Find) As Collection
Set Execute = New Collection
Do While Find.Execute
Execute.Add Find.Parent.Text
Loop
End Function
Sub TransferToExcel(Data As Collection)
Dim i As Long
With CreateObject("Excel.Application")
With .Workbooks.Add
With .Sheets(1)
For i = 1 To Data.Count
.Cells(i, 1) = Data(i)
Next
End With
End With
.Visible = True
End With
End Sub
In MS Word, you can create hyperlinks to a "Place in this document" so that a link takes you someplace else in the same Word file. However, if you change headers or move things around these links will sometimes break. I want to write some VBA to check for broken links.
With VBA, you can list each hyperlink subaddress using the code below:
Sub CheckLinks()
Set doc = ActiveDocument
Dim i
For i = 1 To doc.Hyperlinks.Count
Debug.Print doc.Hyperlinks(i).SubAddress
Next
End Sub
The output from the code above also matches what is shown in the field codes for the hyperlink.
However, I'm not really clear on how to verify if the SubAddress is correct. For example, an excerpt from the program output shows this:
_Find_a_Staff_1
_Edit_Organization_Settings_2
_Set_the_Staff
_Find_a_Staff_1
But there's no obvious way to tell what the "correct" suffix should be for a given heading. Any thoughts on how to check if these are valid?
Is there a way to get the list of all valid subaddresses for the headings in the document?
The code below will list the hyperlinks where the corresponding bookmark does not exist in the document. (Note that it only detects missing links, not links that go to the wrong place.)
Sub CheckLinks()
Dim doc As Document
Set doc = ActiveDocument
Dim i, j
Dim found As Boolean
For i = 1 To doc.Hyperlinks.Count
found = False
For j = 1 To doc.Bookmarks.Count
If doc.Range.Bookmarks(j).Name = doc.Hyperlinks(i).SubAddress Then
found = True
End If
Next
If found = False Then
Debug.Print doc.Hyperlinks(i).SubAddress
End If
Next
End Sub
I have a workbook that gathers data through SQL queries from a database that displays on a website. The queries gather data that is present and displays in a table which provide URL and time posted (these are columns: URL and Time), with this information I have a cell (B25 B28 and others), which uses a =countif formula to gather all the items that are in the table and which ones are past a certain time.
Example:
=COUNTIFS(table_name[URL Column Name],"Items underneath said Column",table_name[Time Column],">"&NOW()-0.167)
I'm trying to create a VBA script in the worksheet that has this information, launch the URL provided from the cell this formula reads, or display a list if there are more than 1 item over the allotted time. Ultimately I need a message box to display the URL.
So far, I have this as my VBA code:
Private Sub Worksheet_Calculate()
Dim lResponse As Long
Set ie = CreateObject("InternetExplorer.Application")
Application.EnableEvents = False
If Me.Range("D25, D28, D31, D34, D37").Value > 0 Then
lResponse = MsgBox("my message for yes or no?", vbQuestion + vbYesNo, "box title")
If lResponse = vbYes Then
ie.Navigate(" & Me.Range &").Value
Else
Exit Sub
End If
End If
Application.EnableEvents = True
End Sub
Thanks in Advance.
Try this, I don't know if it will help but there is.
MyVariable = Range("D25, D28, D31, D34, D37")
for each Mycell in MyVariable
if MyCell.Value > 0 then
..... 'your code
next Mycelll
I am trying to manually set every OptionButton's font on a sheet to be a uniform size and type using a For Loop.
I can do them manually by writing out each specific button's information but I have hundreds of buttons.
I can even get VBA to write the correct syntax to a test Worksheet by using this code here:
`Private Sub Thisworkbook_Open()
For i = 1 to Worksheets("Core").OLEObjects.Count
If TypeName(Worksheets("Core").OLEObjects(i).Object) = "OptionButton" Then
Worksheets("testsheet").Range("A" & i).Value = Worksheets("Core").OLEObjects(i).Name
End If
Next i
End Sub`
But what I can't do is put the rest of this below code along with the above code to have ONE clean and concise statement that will manually set all OptionButton values to these settings:
`With Worksheets("Core").OptionButton1
.Font.Size = 11
.Font.Name = "Calibri"
.Font.Bold = False
End With`
Can someone explain to me how I can make this work?
Actually you have your answer in your question, all you have to do is to put your properties to correct location, as follows:
For i = 1 To Worksheets("Core").OLEObjects.Count
If TypeName(Worksheets("Core").OLEObjects(i).Object) = "OptionButton" Then
Worksheets("Core").OLEObjects(i).Object.FontSize = 5
' Remaining code goes here.
End If
Next i
I have to set up a page in Excel VBA ... the problem is that the page must be borderless. So not just the usual way of the option left,right, top etc. , I also have to manipulate the printer to ensure that no border will be seen... well, I can do that manually, but even if I record the macro... after I finsihed I found out that nothing had been recorded at all for this issue .... don't need help with any macro recording I did it wright... the macro is there... with sub ..... but no VB Code at all... I also could code it manualy.. but how... there isn't any printer object.... any solution ?
I think the following code should help you.
Public Sub PrintButton1_Click()
Dim CurrRange As Range, CurrRange2 As Range
Set CurrRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:--")
Set CurrRange2 = ThisWorkbook.Worksheets("rough").Range("A1:--")
CurrRange2.ClearContents
CurrRange.Copy
CurrRange2.PasteSpecial xlPasteAllExceptBorders
above statement should paste the content in the format you want to take printout.
Then setup the page using the following code and print
With PageSetup
.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1
End With
CurrRange2.PrintOut 1, 1, 1
End Sub