Extract info from web page

I would like to extract the physician's information from this sample page via code:
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.
LVL 39
Who is Participating?
Rey Obrero (Capricorn1)Commented:
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")
If wData <> "" Then

        Call DumpText(wData)
            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
    PageContents = CStr(iz.Document.Body.innerhtml)
   If Len(PageContents) > 0 Then
        Exit Function
        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

thenelsonAuthor Commented:
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?
Rey Obrero (Capricorn1)Commented:
what version of Access do you have?
i am using A2003 and it is located here
Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

thenelsonAuthor Commented:
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!
Rey Obrero (Capricorn1)Commented:
i sent you an email at  nelsonh <at> nosuffering <dot> com
is that mail working still?
thenelsonAuthor Commented:
<is that mail working still?>

Yes, haven't got it yet.
Rey Obrero (Capricorn1)Commented:
<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
End Function
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.