Hi,
How should I modify this code in order for it to run automatically upon opening .xlsm file?
How should I modify this code in order for it to run automatically upon opening .xlsm file?
VBA Code:
Sub scrape_link()
'If any element is not available, the program will move to next line.
On Error Resume Next
Dim HTMLDoc As New HTMLDocument
Dim ieBrowser As New InternetExplorer
Dim reqdValue As String
'To open and show Internet Explorer
ieBrowser.Visible = True
'To Open website in Internet Explorer
ieBrowser.navigate "https://clinicaltrials.gov/ct2/show/study/NCT04201093"
Do
' Wait till the Browser is loaded
Loop Until ieBrowser.readyState = READYSTATE_COMPLETE
Set HTMLDoc = ieBrowser.document
reqdValue = HTMLDoc.getElementById("EXPAND_CONTROL-Locations").innerText
ActiveSheet.Range("B7") = Mid(reqdValue, 8, WorksheetFunction.Find(" ", reqdValue, 8) - 8)
'To Open website in Internet Explorer
ieBrowser.navigate "https://clinicaltrials.gov/ct2/show/NCT04223193?term=NCT04223193&draw=2&rank=1"
Do
' Wait till the Browser is loaded
Loop Until ieBrowser.readyState = READYSTATE_COMPLETE
Set HTMLDoc = ieBrowser.document
reqdValue = HTMLDoc.getElementById("EXPAND_CONTROL-Locations").innerText
ActiveSheet.Range("C7") = Mid(reqdValue, 8, WorksheetFunction.Find(" ", reqdValue, 8) - 8)
'To Open website in Internet Explorer
ieBrowser.navigate "https://clinicaltrials.gov/ct2/show/NCT04542499"
Do
' Wait till the Browser is loaded
Loop Until ieBrowser.readyState = READYSTATE_COMPLETE
Set HTMLDoc = ieBrowser.document
reqdValue = HTMLDoc.getElementById("EXPAND_CONTROL-Locations").innerText
ActiveSheet.Range("D7") = Mid(reqdValue, 8, WorksheetFunction.Find(" ", reqdValue, 8) - 8)
'To Open website in Internet Explorer
ieBrowser.navigate "https://clinicaltrials.gov/ct2/show/NCT04244175"
Do
' Wait till the Browser is loaded
Loop Until ieBrowser.readyState = READYSTATE_COMPLETE
Set HTMLDoc = ieBrowser.document
reqdValue = HTMLDoc.getElementById("EXPAND_CONTROL-Locations").innerText
ActiveSheet.Range("E7") = Mid(reqdValue, 8, WorksheetFunction.Find(" ", reqdValue, 8) - 8)
Set ieBrowser = Nothing
Set HTMLDoc = Nothing
End Sub