web query

[gaa978]

hello
if we have a web page to show grade by entering student ID
how I can export a range of about 1000 student grade to excel

like this
http://www.damascusuniversity.edu.sy/ol/ems/

student id 413900 414500

thanks

 

[Ruddles]

In Excel 2007 I would start by trying Data > From Web.

Incidentally, I presume we need a login to get into that Web site?

 

[gaa978]

no
I need every time to increament student id
i need automated method

 

[Ruddles]

You could try something like this. Create a new workbook with just a Sheet1 in it and place your student ids in column A starting from A2. Paste the following code into a new standard module and run it:-

[FONT=Courier New]Option Explicit[/FONT]
 
[FONT=Courier New]Public Sub GetStudentData()[/FONT]
 
[FONT=Courier New] Dim objIE As Object[/FONT]
[FONT=Courier New] Dim ws As Worksheet[/FONT]
[FONT=Courier New] Dim iLastRow As Long[/FONT]
[FONT=Courier New] Dim iRow As Long[/FONT]
 
[FONT=Courier New] Const sURL As String = "[/FONT][URL="http://www.damascusuniversity.edu.sy/ol/ems/"][FONT=Courier New]http://www.damascusuniversity.edu.sy/ol/ems/[/FONT][/URL][FONT=Courier New]"[/FONT]
[FONT=Courier New] Const sSearchText As String = "<!-- show results for this student -->"[/FONT]
 
[FONT=Courier New] Dim iFound As Long[/FONT]
[FONT=Courier New] Dim sTemp As String[/FONT]
 
[FONT=Courier New] Set ws = ThisWorkbook.Sheets("[COLOR=red][B]Sheet1[/B][/COLOR]")[/FONT]
[FONT=Courier New] ws.Columns("B").ClearContents[/FONT]
[FONT=Courier New] iLastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row[/FONT]
 
[FONT=Courier New] Set objIE = CreateObject("InternetExplorer.Application")[/FONT]
 
[FONT=Courier New] For iRow = 2 To iLastRow[/FONT]
[FONT=Courier New]   With objIE[/FONT]
[FONT=Courier New]     .Visible = True [COLOR=green]' change this to False if you don't want to watch IE in action[/COLOR][/FONT]
[FONT=Courier New]     .Silent = True[/FONT]
[FONT=Courier New]     .Navigate (sURL)[/FONT]
[FONT=Courier New]     Do Until .ReadyState = 4[/FONT]
[FONT=Courier New]       DoEvents[/FONT]
[FONT=Courier New]     Loop[/FONT]
[FONT=Courier New]     Application.Wait Now() + TimeValue("00:00:01") [COLOR=green]' pause before filling in the form and pressing the button[/COLOR][/FONT]
[FONT=Courier New]     .document.all.studentId.Value = ws.Cells(iRow, 1)[/FONT]
[FONT=Courier New]     .document.all.submitCardInfo.Click[/FONT]
[FONT=Courier New]     On Error Resume Next[COLOR=green] ' in case page not available[/COLOR][/FONT]
[FONT=Courier New]     iFound = InStr(.document.body.outerHTML, sSearchText)[/FONT]
[FONT=Courier New]     On Error GoTo 0[/FONT]
[FONT=Courier New]     Do Until iFound > 0[/FONT]
[FONT=Courier New]       On Error Resume Next[COLOR=#008000] ' in case page not available[/COLOR][/FONT]
[FONT=Courier New]       iFound = InStr(.document.body.outerHTML, sSearchText)[/FONT]
[FONT=Courier New]       On Error GoTo 0[/FONT]
[FONT=Courier New]       DoEvents[/FONT]
[FONT=Courier New]     Loop[/FONT]
[FONT=Courier New]     ws.Cells(iRow, 2) = .document.body.innerText[/FONT]
[FONT=Courier New]   End With[/FONT]
[FONT=Courier New] Next iRow[/FONT]
 
[FONT=Courier New] objIE.Quit[/FONT]
[FONT=Courier New] Set objIE = Nothing[/FONT]
 
[FONT=Courier New]End Sub[/FONT]

The text from the results pages will be copied into column B against the matching student id. Once they're there, you can extract the info you need using worksheet functions.

It seems to work okay here although the site was dreadfully slow this morning. Let me know if you have any problems with it.

 

[Ruddles]

This version is better as it has a timeout mechnism built into it: if the page doesn't load, the URL is retried. I've set the timeout to 45 seconds for the moment but if the site takes longer than this to load a page it might need extending. (Set it to 3x or 4x the time a page normally loads in, I think.)

Option Explicit
 
Public Sub GetStudentData()
 
  Dim objIE As Object
  Dim ws As Worksheet
  Dim iLastRow As Long
  Dim iRow As Long
  
  Const sURL As String = "[URL]http://www.damascusuniversity.edu.sy/ol/ems/[/URL]"
  Const sSearchText As String = "<!-- show results for this student -->"
  Const sPause As String = "00:00:02"
  Const sPageTimeout As String = "00:00:45"
  
  Dim dtTimeout As Date
  Dim iFound As Long
  Dim sTemp As String
  
  Set ws = ThisWorkbook.Sheets("Sheet1")
  ws.Columns("B").ClearContents
  iLastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
  
  Set objIE = CreateObject("InternetExplorer.Application")
 
  For iRow = 2 To iLastRow
    Do While IsEmpty(ws.Cells(iRow, 2))
      dtTimeout = Now() + TimeValue(sPageTimeout)
      With objIE
        .Visible = True [COLOR=green]' change this to False if you don't want to watch IE in action
[/COLOR]        .Silent = True
        .Navigate (sURL)
        Do Until .ReadyState = 4 Or Now() > dtTimeout
          DoEvents
        Loop
        If Now() < dtTimeout Then
          Application.Wait Now() + TimeValue(sPause) [COLOR=green]' pause before filling in the form and pressing the button
[/COLOR]          .document.all.studentId.Value = ws.Cells(iRow, 1)
          .document.all.submitCardInfo.Click
          dtTimeout = Now() + TimeValue(sPageTimeout)
          On Error Resume Next ' in case page not available
          iFound = InStr(.document.body.outerHTML, sSearchText)
          On Error GoTo 0
          Do Until iFound > 0 Or Now() > dtTimeout
            On Error Resume Next ' in case page not available
            iFound = InStr(.document.body.outerHTML, sSearchText)
            On Error GoTo 0
            DoEvents
          Loop
          If Now() < dtTimeout Then
            ws.Cells(iRow, 2) = .document.body.innerText
          End If
        End If
      End With
    Loop
  Next iRow
 
  objIE.Quit
  Set objIE = Nothing
  
End Sub

 

[Ruddles]

Hello?

 

[gaa978]

Thank u very much

 

[Ruddles]

But does it work?

 

[gaa978]

yes by copy this line
Application.Wait Now() + TimeValue(sPause) ' pause before filling in the form and pressing the button


after tow lines

 

[Ruddles]