|
Using Vba Code To Extract Web Data
|
|
Search Excel Forum Posts, Tutorials, Macros, Tips, and More
Hello everyone. On a monthly basis I have a procedure to extract data from a website and place that data into an excel worksheet. it does not take long to do, as there is a "button" on the website that you can press to "dump-to-excel". However I would like to use VBA code to inlcude this procedure into some macros I have already developed. The only "variable" in the procudeure involves the user inputing dates in the following format: dd-three letter month abreviation-YYYY. The web data is contained in a nice table in the center of the site. The number or rows varies, but the number of columns is fixed at 5. The intranet site uses IE. The following code sort of works, but as you can tell it does not prompt the user to enter a date. The code below is a good start, I think.
Code:
Sub WB()
URL = "http://cds.worldbank.org/Pages/CurrMain.aspx?rate_date=31-mar-2010"
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
'get web page
IE.navigate2 URL & Ticker
Do While IE.readystate <> 4 Or _
IE.busy = True
DoEvents
Loop
Do While IE.document Is Nothing
DoEvents
Loop
End Sub
I would like to save the table into a worksheet called CDS_Raw.xlsx. Any suggestions would be greatly appreciated. Note that the code above does bring the website open.
I am assuing I should declare a variable say fdate
Code:
Dim fdate As String.
and use that somewhere in the URL?
Similar Excel Video Tutorials
Similar Topics
Hello everyone. Every quarter I have to extract data (currency rates) from a website. For example suppose that it is the month of June I will then have to extract currency rates for the month of April, May and June. Now the code below is able to do this for each month one-at-a-time. However I want to enter the month of June (30-jun-2010), and with the new code retreive the months of (in this order): April, May and June, in one swoop.
Any suggestions? The data is stored in a table. Also the error handling for the date is incorrect.
Code:
Sub WB()
'***************************************************************************
'WB() macro opens the intranet website CDS and accesses the current months,_
'FX rates. It is here for display purposes, to assist in auditing.
'***************************************************************************
fDate = Application.InputBox("Enter a date in the format shown:", "Date to add...", Format(Date, "DD-MMM-YYYY"))
If fDate = "False" Then Exit Sub
fDatePrevious = DateSerial(Year(fDate), Month(fDate), 0)
'**********************************************************************
'Formula used to calculate the prior month.
'**********************************************************************
Dim URL As String
Dim IE As Object
URL = "http://cds.worldbank.org/Pages/CurrMain.aspx?rate_date=" & fDate
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.navigate2 URL
Do While IE.readystate <> 4 Or _
IE.busy = True
'***********************************************************************
'Gets the webpage
'***********************************************************************
DoEvents
Loop
Do While IE.document Is Nothing
DoEvents
Loop
End Sub
Sub CDS_Import()
'*************************************************************************
'CDS_Import() macro extracts the table from the CDS website. It also,_
'formats the table.
'*************************************************************************
Dim sPath1 As String
Const sFileInp1 As String = "CDS.xlsm"
Dim URL As String
Dim wb1 As Workbook
sPath1 = fPath & "157_Support_Summaries\"
URL = "http://cds.worldbank.org/Pages/CurrMain.aspx?rate_date=" & fDate
Set wb1 = Workbooks.Open(sPath1 & sFileInp1)
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://cds.worldbank.org/Pages/CurrMain.aspx?rate_date=" & fDate, _
Destination:=Range("A1"))
.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
Range("A15:E200").Copy
Range("A2").PasteSpecial
Range("A1:E1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
'.MergeCells = True
End With
Cells.Select
With Selection.Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
End With
wb1.Close SaveChanges:=True
End Sub
Sub Main()
Call WB
Call CDS_Import
End Sub
Code:
Sub Log()
Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")
ie.navigate "http://www.excelforum.com"
ie.Visible = True
Do While ie.Busy And Not ie.readyState = 4
DoEvents
Loop
DoEvents
ie.document.all.Item("navbar_username").Value = "MyUser"
ie.document.all.Item("Password").Value = "MyPass"
ie.document.all.Item("submit").Click
End Sub
This is my attempt to create a login to this site using VBA. It does not work. If i can get it to work here, i would like to apply it to other business sites that i log into on a regular basis to save a great deal of time.
If someone can point out where I am going wrong, it would be helpful. Also, for the User and Password, i would like to be able to use a cell reference (A1 & A2)
Thanks
I am trying to use the SendKey method from Excel on a website to start a Search. I am using the SenKey opetion because I can't find the Name of the control in the Website Source Code. When I run the macro with the SendKey {ENTER} nothing happens, below is the code:
Code:
Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")
Sheets("Worklist").Select
ie.Visible = True
ie.Navigate "https://provider2.anthem.com/wps/myportal/ebpmybcbsco"
Do While ie.busy: DoEvents: Loop
Do While ie.ReadyState <> 4: DoEvents: Loop
ie.document.all.Item("wps.portlets.userid").Value = USERNAME
ie.document.all.Item("Password").Value = PASSWORD
ie.document.all.Item("login").Click
Do While ie.busy: DoEvents: Loop
Do While ie.ReadyState <> 4: DoEvents: Loop
With Sheets("Worklist")
Dim lLastRow As Long, i As Long, j As Integer, k As Integer, l As Integer
lLastRow = [a65536].End(3).Row
For i = Range("Start_Row") To lLastRow
'ie.navigate https://provider2.anthem.com/wps/myportal/ebpmybcbsco/kcxml/04_Sj9SPykssy0xPLMnMz0vM0Y_QjzKLNzGJd7FwBslB2Kah-pFYREOQRH098nNT9YOAspHmIDEjS2cP_aic1PTE5Er9YH1v_QD9gtzQiHJvR0cAPKaA4A!!/delta/base64xml/L0lJSk03dWlDU1lKSi9vQXd3QUFNWWdBQ0VJUWhDRUVJaEZLQSEvNEZHZ2RZbktKMEZSb1hmckNIZGgvN180NF8yOUNILzE5MjczOTUvc2EuRUJQLkJDQlNDTy5NZWRpY2FsTG9hZFNlYXJjaE1lbWJlckNsYWltQWN0aW9u?PC_7_44_29CH_breadCrumbIndex=1&PC_7_44_29CH_originPage=MedicalLoadSearchMemberClaimAction#7_44_29CH
'Do While ie.busy: DoEvents: Loop
'Do While ie.ReadyState <> 4: DoEvents: Loop
mbrlast = .Cells(i, "E").Value
mbrfirst = .Cells(i, "F").Value
mbrname = mbrlast & "," & mbrfirst
mbrdob = .Cells(i, "H").Value
mbrdob = Format(mbrdob, "mm/dd/yyyy")
mbrdosbegin = .Cells(i, "N").Value
mbrdosbegin = Format(mbrdosbegin, "mm/dd/yyyy")
mbrdosend = .Cells(i, "N").Value 'serviceFromDateText
mbrdosend = Format(mbrdosend, "mm/dd/yyyy")
mbrid = .Cells(i, "G").Value
npi = "1952373953"
Set frm = ie.document.forms("eligibilityForm")
ie.document.all.Item("memberId")(0).Value = mbrid
ie.document.all.Item("birthDate")(0).Value = mbrdob
SendKeys "{ENTER}"
Do While ie.busy: DoEvents: Loop
Do While ie.ReadyState <> 4: DoEvents: Loop
Sleep 5000
Stop
Hi all,
I have previously posted regarding this query and had the issue basically solved.
Link if interested is http://www.excelforum.com/excel-prog...using-vba.html
However this company has changed the website and it appears this data is now pulled somehow using javascript. Basically I need to pull the date and time on the line which says Delivered and Signed by xxx xxx xxx.
I had this working on their previous site but for the life of me don't know where to start. See code below which is from the old site and I have modified what I can to make it compatible with the new site.
Any help you can give is much appreciated.
Code:
Sub AustralianAir()
Dim IE As Object
Dim frm As Object
Dim srch As Object
Dim tableNum As Integer
Dim rowsNum As Integer
Dim lastScan As String
Dim statusDescr As String
Dim lastRow As Long
Dim startRow As Long
Dim r As Long
Dim r2 As Long
'Testing code
startRow = ActiveCell.Row
'clear previous informations
Range("b:b").ClearContents
'Create Internet Explorer Instance
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
' IE.Navigate "http://webapps.aae.com.au/track/inquiry.html" old line before website reconfigured
IE.Navigate "https://trackandtrace.aae.com.au/"
Do While IE.Busy: DoEvents: Loop
Do While IE.ReadyState <> 4: DoEvents: Loop
lastRow = Cells(Rows.Count, "a").End(xlUp).Row
'For r = r To lastRow
For r = startRow To lastRow
' Set frm = IE.Document.forms("tt") old line before website reconfigured
Set frm = IE.Document.forms("searchForm")
' Set srch = frm.all("inquirynumber") old line before website reconfigured
Set srch = frm.all("txtConsignmentNumber")
srch.Value = Cells(r, "a")
frm.submit
Do While IE.Busy: DoEvents: Loop
Do While IE.ReadyState <> 4: DoEvents: Loop
With IE.Document.all
tableNum = .tags("table").Length
If tableNum > 2 Then ' Way to verify on correct webpage
rowsNum = .tags("table")(tableNum - 2).all.tags("tr").Length ' number of rows in the correct table
For r2 = 4 To rowsNum - 1
lastScan = .tags("table")(tableNum - 2).all.tags("tr")(r2 - 1).Cells(0).innertext
' MsgBox (lastScan) ' Error checking code
statusDescr = .tags("table")(tableNum - 2).all.tags("tr")(r2 - 1).Cells(3).innertext
' MsgBox (statusDescr) ' Error checking code
If statusDescr Like "*eliver*" Then
Cells(r, "b") = lastScan
Exit For
End If
If statusDescr Like "*uthorit*" Then
Cells(r, "b") = lastScan
Exit For
End If
If statusDescr Like "*ollect*" Then
Cells(r, "b") = lastScan
Exit For
End If
If statusDescr Like "*rrived*loc*" Then
Cells(r, "b") = lastScan
Exit For
End If
Next r2
End If
End With
Do While IE.Busy: DoEvents: Loop
Do While IE.ReadyState <> 4: DoEvents: Loop
Application.Wait (DateAdd("s", 4, Now())) ' Should be able to replace this with a busy timer but leaving as is for testing
IE.Navigate "https://trackandtrace.aae.com.au/" ' To get prepared for next connote to be entered
Application.Wait (DateAdd("s", 5, Now())) ' To ensure page fully loads
Do While IE.Busy: DoEvents: Loop
Do While IE.ReadyState <> 4: DoEvents: Loop
Next r
IE.Quit
End Sub
Hello everyone. I have a workbook that has data imported into it via a website ( please see the code below). The workbook is called CDS.xlsm. The data is placed onto a worksheet called CDS. I would like to include into the code two named ranges one called Current_CDS_Rates and another called Prior_CDS_Rates, with cell references $B$2:$D$200 and $H$2:$J$200, respectively. This file is recreated on a monthly basis, and Current_CDS_Rates and Prior_CDS_Rates need to be the only named ranges, with the exact cell references everytime.
Notice that CDS workbook is not created. It already exist. I tried to simply put the named ranges into the worksheet. But, as I simulated monthly roll-overs, I noticed that the named ranges were not preserved. Any help would be appreciated.
Code:
Sub CDS_Import()
'*************************************************************************
'CDS_Import() macro extracts the table from the CDS website. It also,_
'formats the table.
'*************************************************************************
Dim sPath1 As String
Const sFileInp1 As String = "CDS.xlsm"
Dim URL As String
Dim wb1 As Workbook
sPath1 = fPath & fDate & "_157\Support_Summaries\"
URL = "http://cds.worldbank.org/Pages/CurrMain.aspx?rate_date=" & fDate
Set wb1 = Workbooks.Open(sPath1 & sFileInp1)
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://cds.worldbank.org/Pages/CurrMain.aspx?rate_date=" & fDate, _
Destination:=Range("A1"))
.Name = "102303"
.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
Range("A15:E200").Copy
Range("A1").PasteSpecial
Range("A1:E1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Cells.Select
With Selection.Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
End With
wb1.Close SaveChanges:=True
End Sub
Hi
I have the below code which opens a web page, enter log in details, clicks a button 'Export to Excel'. Till here the codes works fine, now I want just a line to save the file in C drive.
Code:
Sub Web_Top_Login1()
Dim IE As Object
'Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
'(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'Dim sFName
Set myIE = CreateObject("InternetExplorer.Application")
myIE.Visible = True
With myIE
.Navigate "http://test.com" ' Actual site name is changed due to security reason
Do While .Busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
.Visible = True
With .Document.forms("ReportsSearch_0")
.date_date.Value = "11-May-2011"
.ReportsSearch_Button_0.Click
Do While myIE.Busy: DoEvents: Loop
'Click 'Export to Excel
myIE.Document.forms("ReportsSearch_0").ReportsSearch_Button_4.Click
End With
End With
End Sub
the above codes works fine for me. but after the click, i get a dialogue box saying
"File Download - Security Warning "Do you want to save this file, or find a program only to open it?"
I need a code to click save and the file has to be saved in C:/MyDocuments folder
Can you guys help me...
Good Morning
I am trying to automatically log on to a website site using a login and password.
I have created a sample code to log on to the website and enter the relevant username and password but I can't get the submit button to work.
Any ideas on where I am going wrong
Sub GetTable()
Dim ieApp As InternetExplorer
Dim ieDoc As Object
Set ieApp = New InternetExplorer
ieApp.Visible = True
ieApp.Navigate "http://fantasyfootball.dailymail.co.uk/log-in"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
Set ieDoc = ieApp.Document
With ieDoc.forms(0)
.Email.Value = "n.collins@tauntondeane.gov.uk"
.pass.Value = "arsenal"
.ieDoc.submit
End With
End Sub
Hello everyone. What are good programming techniques for VBA, for examples: indentation and varaible declaration, that one should consider when writing code. I have a project, still not done - but it does work. However I have this feeling that it is bloated, cumbersome and slow - and it is. Below is the bulk of the code. Any sugguestions on how to tighten things up?
Code:
Option Explicit
Dim fDate As String
Dim fPath As String
Dim fDatePrevious As String
Dim fPriorDate As String
__________________________________________________________
Sub CreateFolder()
Dim Fldr As String
Dim ErrBuf As String
fDate = Application.InputBox("Enter a date in the format shown:", "Date to add...", Format(Date, "DD-MMM-YYYY"))
If fDate = "False" Then Exit Sub
fDatePrevious = DateSerial(Year(fDate), Month(fDate), 0)
fPath = "L:\"
On Error GoTo ErrorHandler
Fldr = fPath & fDate & "_157"
MkDir Fldr
Fldr = fPath & fDate & "_157\" & "157_Reports"
MkDir Fldr
Fldr = fPath & fDate & "_157\" & "Support_Summaries"
MkDir Fldr
Fldr = fPath & fDate & "_157\" & "157_Reports\" & "Roll_forward_wTA"
MkDir Fldr
Fldr = fPath & fDate & "_157\" & "157_Reports\" & "Roll_forward_12m"
MkDir Fldr
Fldr = fPath & fDate & "_157\" & "157_Reports\" & "Terminated"
MkDir Fldr
Fldr = fPath & fDate & "_157\" & "157_Reports\" & "L3_IDA"
MkDir Fldr
Fldr = fPath & fDate & "_157\" & "157_Reports\" & "IBRD_L3"
MkDir Fldr
Fldr = fPath & fDate & "_157\" & "105_Reports"
MkDir Fldr
If Len(ErrBuf) > 0 Then MsgBox "The following folders already existed:" & vbLf & vbLf & ErrBuf
Exit Sub
ErrorHandler:
ErrBuf = ErrBuf & vbLf & Fldr
Resume Next
End Sub
___________________________________________________________
Sub MoveFilesFolder2Folder()
Dim fso
Dim sfol As String
Dim dfol As String
fPriorDate = Format(fDatePrevious, "DD-MMM-YYYY")
sfol = "L:\" & fPriorDate & "_157\" & "Support_Summaries\"
dfol = fPath & fDate & "_157\" & "Support_Summaries"
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
If Not fso.FolderExists(sfol) Then
MsgBox sfol & " is not a valid folder/path.", vbInformation, "Invalid Source"
ElseIf Not fso.FolderExists(dfol) Then
MsgBox dfol & " is not a valid folder/path.", vbInformation, "Invalid Destination"
Else
fso.CopyFile (sfol & "\*.*"), dfol ' Change "\*.*" to "\*.xls" to move Excel Files only
End If
If Err.Number = 53 Then MsgBox "File not found"
End Sub
______________________________________________________________________
Sub CreateFiles()
Dim sPath1 As String
Dim sPath2 As String
Const sFileOut1 As String = "105_version1.xlsm"
Const sFileOut2 As String = "_CDS.xlsm"
sPath1 = fPath & fDate & "_157\105_Reports\"
sPath2 = fPath & fDate & "_157\Support_Summaries\"
fPriorDate = Format(fDatePrevious, "DD-MMM-YYYY")
Workbooks.Add
With ActiveSheet
.Name = fDate & "_105_v1"
.Parent.SaveAs Filename:=sPath1 & sFileOut1, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
CreateBackup:=False
.Parent.Close
End With
Workbooks.Add
With ActiveSheet
.Name = fPriorDate & "_CDS"
.Parent.SaveAs Filename:=sPath2 & fPriorDate & sFileOut2, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
CreateBackup:=False
.Parent.Close
End With
End Sub
____________________________________________________________
Sub CDS_Roll_Over()
Dim sPath1 As String
Const sFileInp1 As String = "CDS.xlsm"
Const sFileInp2 As String = "_CDS.xlsm"
Dim wb1 As Workbook
Dim wb2 As Workbook
sPath1 = fPath & fDate & "_157\Support_Summaries\"
Set wb1 = Workbooks.Open(sPath1 & sFileInp1)
Range("A1:E200").Copy
Set wb2 = Workbooks.Open(sPath1 & fPriorDate & sFileInp2)
With ActiveSheet
.Range("A1").PasteSpecial
End With
wb2.Close SaveChanges:=True
End Sub
____________________________________________________
Sub WB()
Dim URL As String
Dim IE As Object
URL = "http://cds.worldbank.org/Pages/CurrMain.aspx?rate_date=" & fDate
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
'get web page
IE.navigate2 URL
Do While IE.readystate <> 4 Or _
IE.busy = True
DoEvents
Loop
Do While IE.document Is Nothing
DoEvents
Loop
End Sub
__________________________________________________________
Sub CDS_Import()
Dim sPath1 As String
Const sFileInp1 As String = "CDS.xlsm"
Dim URL As String
Dim wb1 As Workbook
sPath1 = fPath & fDate & "_157\Support_Summaries\"
URL = "http://cds.worldbank.org/Pages/CurrMain.aspx?rate_date=" & fDate
Set wb1 = Workbooks.Open(sPath1 & sFileInp1)
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://cds.worldbank.org/Pages/CurrMain.aspx?rate_date=" & fDate, _
Destination:=Range("A1"))
.Name = "102303"
.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
Range("A15:E200").Copy
Range("A1").PasteSpecial
Range("A1:E1").Select
Range("E1").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Cells.Select
With Selection.Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
End With
wb1.Close SaveChanges:=True
End Sub
I found this code on a site but was unable to identify the programmer. I need to fix one problem I have with the code. When I log into my specific site, after entering the login and password I get a window that pops asking me if I would like to proceed. How do I select the yes button on the pop up?
Code:
Sub LoginToURL()
Dim ie As Object, strURL As String, strUsername As String, strPassword As String
Set ie = CreateObject("InternetExplorer.Application")
strURL = "http://www.skytronic.co.uk/product/index.php?s=128.685"
strUsername = "guest"
strPassword = "password"
ie.Navigate strURL
'Wait until page is loaded.
While ie.ReadyState < 4 ' READYSTATE_COMPLETE = 4
DoEvents
Wend
ie.Visible = True
ie.Document.All("username").Value = strUsername
ie.Document.All("password").Value = strPassword
ie.Document.All("submit").Click
'Wait until page is loaded.
While ie.ReadyState < 4 ' READYSTATE_COMPLETE = 4
DoEvents
Wend
Application.Wait (Now + TimeValue("0:00:05"))
urldownloadtofile http://www.skytronic.co.uk/product/index.php?s=128.685.txt
End Sub
I currently use this macro to open the specific website and login (which I got from this forum and it works perfectly!! - as long as you enable/Reference Microsoft XML v4.0)
Code:
Sub WebpageLogin()
Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")
ie.navigate "https://webpage.com/Login"
ie.Visible = True
Do While ie.Busy And Not ie.readyState = 4
DoEvents
Loop
DoEvents
ie.document.all.Item("txtUserName").Value = "username"
ie.document.all.Item("txtPassword").Value = "password"
ie.document.all.Item("btnLogin").Click
End Sub
However...I would like to write another macro to extract information from this already opened webpage.
I can't "CreateObject" again, because I'd have to login all over again...
How could I start a macro, to reference the already opened webpage?
Once I have logged in...the webpage is a 'search' screen. I have to search different 'cases' for specific bits of information.
So would I continue to use ie.document.all.Item("txtUserName").Value to fill in different fields, like the case number?
Once the 'case' screen is opened... what Code would I use to actually Extract information from the different fields?
Can anyone help?
Thanks!
M
hi i have written a code where it opens a website and enter in by giving a
username and password. Then there is a serach box. I need to enter some data
into that search box which i have done the problem is now i am unable to
submit it. And once it enter into the next page it should click on a
particular link and should open that link from which i take the necessary
data. Please some one help me on this.
Private Sub CommandButton1_Click()
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.navigate "http://www.moodys.com/cust/default.asp"
.FullScreen = False
Do Until .readyState = 4: DoEvents: Loop
Do While .busy: DoEvents: Loop
Set mytextfield = .document.all.Item("userid")
mytextfield.Value = "amitavah"
Set mytextfield1 = .document.all.Item("passwd")
mytextfield1.Value = "amitava"
ie.document.forms("form1").submit
Set mytextfield2 = .document.all.Item("searchQuery")
mytextfield2.Value = "Aquila Inc"
ie.document.forms(0).submit
End With
End Sub
Hi Guys,
I hope someone can help me, I have managed to manipulate a website by entering some dates into the input boxes then go to another page with the information I need. I am wondering if anyone knows a macro I can use to copy the data directly to a new worksheet?? my code is below
Code:
Sub HiltonPortsmouth()
Dim ie As Object
On Error GoTo 1
Set objWSS = CreateObject("WScript.Shell")
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.navigate "https://www.hilton.co.uk/Reservation/300_CheckAvailability.jsp?hid=11001839"
Do While busy: DoEvents: Loop
Do While .ReadyState <> 4: DoEvents: Loop
With .document.Forms("checkavailabilityform")
.day1.Value = Worksheets("setup").Range("C59").Text
.monthyear1.Value = Worksheets("setup").Range("C60").Text
.day2.Value = Worksheets("setup").Range("C61").Text
.monthyear2.Value = Worksheets("setup").Range("C62").Text
.submit
End With
Set ie = Nothing
Exit Sub
1: MsgBox "Unexpected Error, sorry."
ie.Quit
Set ie = Nothing
End With
End Sub
Hi all.
I am trying to control a website from Excel VBA. It has page source below:
<FORM class=chooser_form id=chooser_form name=chooser_form
onsubmit="return false;" action=http://www.example.com/ method=post>
<INPUT type=hidden value=en name=lang>
<DIV class=entry_url_out>
<INPUT class=entry_url name=URL>
</DIV>
<DIV class=selector_site_2_out>
<SELECT class=selector_site_2 onchange=change_info(document.chooser_form.site.selectedIndex); name=site>
<OPTION value=Option1>Option1</OPTION>
<OPTION value=Option2>Option2</OPTION>
</SELECT>
</DIV>
<INPUT class=entry_submit onfocus=this.blur(); onclick=buttonDownload() type=submit>
</FORM>
That website change a text into another text. Normaly under IE, we must type on the input box in that website, and click the button. Afterwards, that web show the result.
By this code below, I have succeed to enter a text in to the input box, but I can't "click" in the button because that button didnt have a name. Here is my code
Private Sub OpenWebPageAndInput_Click()
Dim objIE As Object
On Error GoTo error_handler
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
.Navigate "www.example.htm"
Do While .Busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
.Visible = True
With .Document.Forms("chooser_form")
.URL.Value = "test"
.submit '< this line was error
End With
End With
Set objIE = Nothing
Exit Sub
error_handler:
MsgBox ("Unexpected Error, I'm quitting.")
objIE.Quit
Set objIE = Nothing
End Sub
I have tried SendKeys "{ENTER}", True but it was fail too
I guess, that website use a Javascript or Ajax to send the input data to function "buttonDownload". Please help.
I am trying to control a website from Excel VBA. It has page source
below:
<FORM class=chooser_form id=chooser_form name=chooser_form
onsubmit="return false;" action=http://www.example.com/ method=post>
<INPUT type=hidden value=en name=lang>
<DIV class=entry_url_out>
<INPUT class=entry_url name=URL>
</DIV>
<DIV class=selector_site_2_out>
<SELECT class=selector_site_2
onchange=change_info(document.chooser_form.site.selectedIndex);
name=site>
<OPTION value=Option1>Option1</OPTION>
<OPTION value=Option2>Option2</OPTION>
</SELECT>
</DIV>
<INPUT class=entry_submit onfocus=this.blur(); onclick=buttonDownload()
type=submit>
</FORM>
That website change a text into another text. Normaly under IE, we must
type on the input box in that website, and click the button.
Afterwards, that web show the result.
By this code below, I have succeed to enter a text in to the input box,
but I can't "click" in the button because that button didnt have a
name. Here is my code
Private Sub OpenWebPageAndInput_Click()
Dim objIE As Object
On Error GoTo error_handler
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
.Navigate "www.example.htm"
Do While .Busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
.Visible = True
With .Document.Forms("chooser_form")
.URL.Value = "test"
.submit '< this line was error
End With
End With
Set objIE = Nothing
Exit Sub
error_handler:
MsgBox ("Unexpected Error, I'm quitting.")
objIE.Quit
Set objIE = Nothing
End Sub
I have tried SendKeys "{ENTER}", True but it was fail too
Hi everyone I am getting stuck on a program I am writing at work.
What I'm attempting to do: I have an excel sheet program, this excel program will open IE and navigate to a website (newegg for example) when the website loads, it will insert a stored variable from the excel sheet into the search field of the website (sony battery for example). Once the new page loads, the URL of the new page is then stored as a variable.
Is this even possible to do with VBA?
any help is much appreciated
here is what I have so far: New IE window opens and is directed to the site
Code:
Sub VisitWebsite()
Dim ie As Object
Set ie = CreateObject("INTERNETEXPLORER.APPLICATION")
ie.NAVIGATE "http://www.newegg.com"
ie.Visible = True
While ie.busy
DoEvents
Wend
End Sub
odo-
Afternoon All,
I have spent hours trying different ways to get this to work and I just can't figure it out.
I currently have a macro that opens up Internet Explorer to a webpage that I need info from. I then need it to click the submit button at the bottom to run the report. This is an internal website that houses volume data. I can not link straight to the webpage I need. When I try it says for security reasons you can not go straight to the pages you need to access through the website. So i have gotten it to open up the webpage I need all I need now is for the submit button to be pressed to load the report.
Here is my current code:
Code:
Sub Websearching()
Dim ie As Object
Set ie = CreateObject("INTERNETEXPLORER.APPLICATION")
ie.NAVIGATE "http://fraud.intra.aexp.com/trpts/trpt3.asp"
ie.Visible = True
While ie.busy
DoEvents
Wend
End Sub
Here is the HTML Code for the button on the website:
Code:
<td>
<div align="center"><font color="#008080">
<input type="submit" value="Run Report" class="SubmitButton" id="submit1" name="submit1">
</font></div>
</td>
Hello everyone. I have created a multipage Userform, each page containing a button that when pressed prompts the user to enter a date and then press ok. After pressing ok a specific automation is executed. The date entered after pressing each button is the same for example 30-Jun-2010. So what I figured I could do is have the user enter the date on the actual userform, and simply read the date there, subsequently when the buttons are pressed on the other pages it will always refer to the date that was entered onto the userform. Below is code for how I am currently gathering date information. Thanks
Code:
fDate = Application.InputBox("Enter a date in the format shown:", "Date to add...", Format(Date, "DD-MMM-YYYY"))
If fDate = "False" Then Exit Sub
fDatePrevious1 = DateSerial(Year(fDate), Month(fDate), 0)
fPriorDate1 = Format(fDatePrevious1, "DD-MMM-YYYY")
fDatePrevious2 = DateSerial(Year(fDate), Month(fDate) - 1, 0)
fPriorDate2 = Format(fDatePrevious2, "DD-MMM-YYYY")
fDatePrevious3 = DateSerial(Year(fDate), Month(fDate) - 2, 0)
fPriorDate3 = Format(fDatePrevious3, "DD-MMM-YYYY").
Hi all, could somebody help me. I am trying to control a website from
Excel VBA. It has page source below:
<FORM class=chooser_form id=chooser_form name=chooser_form
onsubmit="return false;" action=http://www.example.com/blog.php
method=post>
<INPUT type=hidden value=en name=lang>
<DIV class=entry_url_out>
<INPUT class=entry_url name=URL>
</DIV>
<DIV class=selector_site_2_out>
<SELECT class=selector_site_2
onchange=change_info(document.chooser_form.site.selectedIndex);
name=site>
<OPTION value=Option1>Option1</OPTION>
<OPTION value=Option2>Option2</OPTION>
</SELECT>
</DIV>
<INPUT class=entry_submit onfocus=this.blur(); onclick=buttonDownload()
type=submit>
</FORM>
That website change a text into another text. Normaly under IE, we must
type on the input box in that website, and click the button.
Afterwards, that web show the result.
I guess that website use Java or Ajax programming when we clicked the
button to send XMLHTTP and send request to web server.
By this code below, I have succeed to enter a text in to the input box,
but I can't "click" in the button because that button didnt have a
name. Here is my code
Private Sub OpenWebPageAndInput_Click()
Dim objIE As Object
On Error GoTo error_handler
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
.Navigate "www.example.com/example.php"
Do While .Busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
.Visible = True
With .Document.Forms("chooser_form")
.URL.Value = "test"
.submit '< this line was error
End With
End With
Set objIE = Nothing
Exit Sub
error_handler:
MsgBox ("Unexpected Error, I'm quitting.")
objIE.Quit
Set objIE = Nothing
End Sub
I have tried SendKeys "{ENTER}", True but it was fail too
Hi there,
Im trying to get data from a Sharepoint list to autodownload into excel, so far with my script I can access the website, login, navigate to the page with the datagrid list... and then im stuck.. I have no idea how to copy the data from the list and bring it back to paste in excel.
The code below is from the source file of the page im trying to get the data from.. I have no idea if it will assist anyone!
form name="aspnetForm" method="post" action="ExcelExportView.aspx" onsubmit="javascript:return WebForm_OnSubmit();" id="aspnetForm"
if you need any more info let me know!
This is my code so far
Code:
Private Sub CommandButton1_Click()
If TextBox1.Value = "" Or TextBox3.Value = "" Then Exit Sub
UserForm1.Hide
Dim EXP
Set EXP = CreateObject("InternetExplorer.application")
EXP.Visible = True
'put the webpage here
EXP.Navigate ("http://mysharepointsite.com")
Do While EXP.Busy: DoEvents: Loop
Do While EXP.ReadyState 4: DoEvents: Loop
With EXP.Document.Forms("logonForm")
.UserName.Value = TextBox1.Text
.Password.Value = TextBox3.Text
.Submit
End With
Do While EXP.Busy: DoEvents: Loop
Do While EXP.ReadyState 4: DoEvents: Loop
EXP.Navigate ("http://mysharepointsite.com/dataviewpage")
Do While EXP.Busy: DoEvents: Loop
Do While EXP.ReadyState 4: DoEvents: Loop
With EXP.Document.Forms("aspnetForm")
''''''Im guessing the above line is correct and from here Im stuck''''''''
End With
End Sub
Hi.
I have the following code in Excel but have come to a dead end;
Option Explicit
Public Enum IE_READYSTATE
Uninitialised = 0
Loading = 1
Loaded = 1
Interactive = 1
complete = 4
End Enum
Public Sub GetRegInfo()
Dim ie As Object
Dim doc As HTMLDocument
Dim PageForm As HTMLFormElement
Dim acceptTC As HTMLInputElement
Dim regno As HTMLInputElement
Dim Elem As IHTMLElement
Dim cURL As String
Dim reg As String
Dim titledetails As HTMLDivElement
Dim output As String
cURL = "http://ownvehicle.askmid.com/"
reg = "GM04MGE"
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate cURL
Do While ie.busy Or Not ie.readyState = IE_READYSTATE.complete: DoEvents: Loop
Set doc = ie.document
Set PageForm = doc.forms(0)
Set regno = PageForm.elements("regno")
regno.Value = reg
Set acceptTC = PageForm.elements("acceptTC")
acceptTC.Click
Do While ie.busy Or Not ie.readyState = IE_READYSTATE.complete: DoEvents: Loop
SendKeys "{Enter}", True
Do While ie.busy Or Not ie.readyState = IE_READYSTATE.complete: DoEvents: Loop
Set PageForm = doc.forms(0)
titledetails = PageForm.elements("titledetails")
MsgBox (titledetails)
End Sub
I am trying to capture data contained within "titledetails" on the web page.
I am receiving the error variable not set.
Thanks
This particular thread is continued from my previous post that I am bumping because no one has fixed it yet . This is by far the toughest Exel issue I have ever ran across so far.
The below code represents my efforts on trying to take a website and fire an onchange event that has a postback procedure within the table I am trying to access. It seems like I cannot get it to trigger. I used the below code on this website and it worked:
http://www.dotnetmonster.com/Uwe/Thr...he-back-button
But it will not work on mine. Any suggestions for firing this event properly with the table and onchange etc.?
Option Explicit
Sub FVP()
Dim appIE As Object
Dim doc As Object
Dim frmNav As Object
Dim ddTool As Object
Dim btnSubmit As Object
Set appIE = CreateObject("INTERNETEXPLORER.APPLICATION")
appIE.Visible = True
appIE.navigate "Company Website"
Do While appIE.Busy: DoEvents: Loop
Do While appIE.ReadyState 4: DoEvents: Loop
Set doc = appIE.document
Do While doc.ReadyState "complete": DoEvents: Loop
Set ddTool = doc.getelementbyid("ELID") ' this is where I put the drop down id for the table onchange event
Do While doc.ReadyState "complete": DoEvents: Loop
ddTool.selectedindex = 1 'This is where the Code Breaks
Do While doc.ReadyState "complete": DoEvents: Loop
ddTool.onchange
Do While doc.ReadyState "complete": DoEvents: Loop
Set appIE = Nothing
End Sub
HTML Code:
<!--<input type="submit" id="sbu_btn" class="sub_btn" value=" Login " class="sub_btn">-->
<input type="image" src="images/login.gif">
and
Code:
Code:
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.navigate "http://www.thesite.com/login.php"
Do Until .readystate = 4: DoEvents: Loop
Do While ie.busy: DoEvents: Loop
Set fa1 = .document.getelementbyid("user")
fa1.Value = "usern" 'usern
Set ea = .document.getelementbyid("pass")
ea.Value = "pass" 'pwd
ie.document.getelementbyid("sbu_btn").Click
Do Until .readystate = 4: DoEvents: Loop
Do While ie.busy: DoEvents: Loop
ok, in the first code snippet you can see where the input type 'submit' was changed to input type 'image'.
before the change i could log in using the second bit of code.
what code is there to 'click' on the image?
Hi,
I'm looking for a way to use VBA to uncheck a check-box on a website (it is permanently checked and I want to uncheck it).
Here's what I have
Code:
Sub Facebook_Login_Terry()
Set ie = CreateObject("InternetExplorer.application")
ie.Visible = True
ie.Navigate ("http://www.facebook.com")
Do
If ie.ReadyState = 4 Then
ie.Visible = True
Exit Do
Else
DoEvents
End If
Loop
ie.Document.Forms(0).all("email").Value = "Email address here"
ie.Document.Forms(0).all("Pass").Value = "password"
ie.Document.Forms(0).submit
End Sub
and here's the HTML Ccode
Code:
<tr>
<td>
<input name="email" tabIndex="1" class="inputtext" id="email" type="text"/>
<td>
<input name="pass" tabIndex="2" class="inputtext" id="pass" type="password"/>
<td>
<label class="uiButton uiButtonConfirm" for="u168241_3">
<input tabIndex="4" id="u168241_3" type="submit" value="Log in"/>
<tr>
<td class="login_form_label_field">
<input name="persistent" class="inputcheckbox" id="persistent" type="checkbox" CHECKED="checked" value="1"/>
<input name="default_persistent" type="hidden" value="1"/>
<label id="label_persistent" for="persistent">
Text - Keep me logged in
What do I need to insert into the VBA code to ensure the check box "persistent" is unchecked.
Thanks
Terry
Hi Forum
I have run into a little problem. Every week i must download data from a web site to be feed into various dashboards. I am using the below code with google as an example but when i try to use the sendkeys command to tab down the website nothing happens.
Code:
Dim ie As InternetExplorer
Dim MyStr As String
Set ie = New InternetExplorer
ie.Navigate "http://google.com"
ie.Visible = True
SendKeys "%{tab}"
SendKeys "%{tab}"
SendKeys "%{tab}"
SendKeys "%{tab}"
SendKeys "%{tab}"
SendKeys "%{tab}"
Application.SendKeys "%{Enter}"
can anyone help?
Thanks
Code:
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate "http://www.custwebsite.com"
Do
If IE.ReadyState = 4 Then
IE.Visible = False
Exit Do
Else
DoEvents
End If
Loop
IE.Visible = True
SendKeys "username", True
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "password", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{ENTER}", True
Application.Wait (Now + TimeValue("0:00:04"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{ENTER}", True ' admin functiond
Application.Wait (Now + TimeValue("0:00:04"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys textfile.txt ' insert upload file name
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{END}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{ENTER}", True
I use this code to start IE, navigate to a webpage, insert username and password, insert a file name to upload, then TAB to the UPLOAD button and sendkey an ENTER. Most of the waits are so I can watch the process. Everything works fine till I sendkey the ENTER on the UPLOAD button. The first thing that happens is I start getting the slow green progress bars and an eventual failure. Rather than waiting for the failure I use the IE STOP button. Then, if I press enter or click on the UPLOAD button the upload function works perfectly. (using XP and Excel 2007) Any suggestions? Thanks.
|
|
