Email:      Pass:    Pass?
Close Window   
TE
Subscribe for Email Updates!
Excel tips, help, and more!
E-mail:


Advertisements


Free Excel Forum

Using Vba Code To Extract Web Data

Forum Register
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?

View Answers     

Similar Excel Video Tutorials

Helpful Excel Macros

Excel Macro to Save a Specific Worksheet as a New File
- This Excel Macro allows you to save a specific worksheet within the Excel Workbook to its own new file. You will be a
Save the Current Worksheet as a New Excel Workbook File
- This Excel Macro will save the currently visible/active worksheet (the one that you see when you run the macro) to a
Macro to add a New Line to Message Box Pop-up Windows in Excel
- This is a very simple Message Box, pop-up window, macro for Excel that illustrates how to put new lines, the same thi
Complete Guide to Printing in Excel Macros - PrintOut Method in Excel
- This free Excel macro illustrates all of the possible parameters and arguments that you can include in the PrintOut Meth
Excel Macro that Searches Entire Workbook and Returns All Matches
- This is the ultimate Lookup Macro for Excel. It will search every worksheet in the workbook and return all of the mat

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="&nbsp;&nbsp;&nbsp;Login&nbsp;&nbsp;&nbsp;" 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.