?
Solved

Extract info from web page

Posted on 2007-08-09
7
Medium Priority
?
563 Views
Last Modified: 2013-11-28
I would like to extract the physician's information from this sample page via code:
http://www.upinregistry.com/provider_detail.asp?KeyField=B207930003
I want to push a button and fill all the values on this page into my active form.

For example: I would like to extract the PHYSICIAN UPIN Value:   "B20793" in this sample page and insert it into the UPIN control on my active form.

Inserting the data into the control is no problem extracting the "B20793" (and other values) is what I would like help with.
0
Comment
Question by:thenelson
  • 4
  • 3
7 Comments
 
LVL 120

Accepted Solution

by:
Rey Obrero (Capricorn1) earned 2000 total points
ID: 19661643
Nelson,
place this codes in a form's module
you need to add Microsoft Internet control to your references

* this will extract the web info and dump to a text file "C:\WebInfo.txt"
* to get the info from the text file, just parse the data


Private Sub cmdGetInfo_Click()
Dim WC As String, wData As String
Static sTry As Integer
WC = PageContents("http://www.upinregistry.com/provider_detail.asp?KeyField=B207930003")
wData = BetweenHmm(WC, "PHYSICIAN NAME", "REPEAT MEDICARE PHYSICIAN SEARCH")
If wData <> "" Then

        Call DumpText(wData)
        Else
            MsgBox "Please try the operation again"
            sTry = sTry + 1
            If sTry < 3 Then Exit Sub
            sTry = 0
           
        Exit Sub
End If

End Sub
Sub DumpText(wData As String)
Dim fName As String
fName = "C:\WebInfo.txt"
Dim fHandle
fHandle = FreeFile

Open fName For Output As fHandle
Print #fHandle, wData
Close fHandle

End Sub

Function PageContents(sURL As String) As String
On Error Resume Next
Dim iz As New InternetExplorer, j As Integer
j = 3
iz.Navigate sURL
Connect: Do Until iz.Busy = False
    DoEvents
Loop
    PageContents = CStr(iz.Document.Body.innerhtml)
   If Len(PageContents) > 0 Then
        Exit Function
    Else
        j = j - 1
            If j = 0 Then
                MsgBox "Please try again later " & vbCrLf & _
                        "Server is busy or down"
            Exit Function
            End If
        GoTo Connect:
    End If
End Function


Function BetweenHmm(ByVal sFrom As String, ByVal sStart As String, ByVal sEnd As String) As String
  Dim BegPos: BegPos = InStr(1, sFrom, sStart, 1)
  If BegPos > 0 Then
  '  BegPos = BegPos + Len(sStart)
    Dim EndPos: EndPos = InStr(BegPos, sFrom, sEnd, 1)
    If EndPos = 0 Then EndPos = InStr(BegPos, sFrom, vbCrLf, 1)
    If EndPos = 0 Then EndPos = Len(sFrom) + 1
    BetweenHmm = Mid(sFrom, BegPos, EndPos - BegPos)
  End If
End Function


0
 
LVL 39

Author Comment

by:thenelson
ID: 19661889
Thanks Cap!

I did not see Microsoft Internet control in the list of references.  Where would I find it?

Also, how would I get the URL for WC = PageContents from the browser via code?
0
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 19661930
what version of Access do you have?
i am using A2003 and it is located here
C:\WINDOWS\system32\shdocvw.dll
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 39

Author Comment

by:thenelson
ID: 19662208
what version of Access do you have?
Also A2003

Great! that did it!

As far as "how would I get the URL for WC = PageContents from the browser via code?"  I'll search for that or ask another question.

Thanks!  A great code piece!
0
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 19662244
<ot>
i sent you an email at  nelsonh <at> nosuffering <dot> com
is that mail working still?
</ot>
0
 
LVL 39

Author Comment

by:thenelson
ID: 19662571
<is that mail working still?>

Yes, haven't got it yet.
0
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 19662602
<how would I get the URL>
i got this from my chest box (works for IE)
* you have to pass a portion of the title of the web page and the web page must be open...

Function getURL(vTitle As String)
On Error Resume Next

    Dim shlShellWindows As New SHDocVw.ShellWindows
    Dim expExplorer As SHDocVw.InternetExplorer
    Dim sURL As String, sTitle As String
    For Each expExplorer In shlShellWindows
   
        sTitle = expExplorer.LocationName
        If InStr(sTitle, vTitle) > 0 Then
            getURL = expExplorer.LocationURL
            Exit Function
        End If
     Next
   
End Function
0

Featured Post

Configuration Guide and Best Practices

Read the guide to learn how to orchestrate Data ONTAP, create application-consistent backups and enable fast recovery from NetApp storage snapshots. Version 9.5 also contains performance and scalability enhancements to meet the needs of the largest enterprise environments.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The Windows Phone Theme Colours is a tight, powerful, and well balanced palette. This tiny Access application makes it a snap to select and pick a value. And it doubles as an intro to implementing WithEvents, one of Access' hidden gems.
Sometimes MS breaks things just for fun... In Access 2003, only the maximum allowable SQL string length could cause problems as you built a recordset. Now, when using string data in a WHERE clause, the 'identifier' maximum is 128 characters. So, …
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…

840 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question