Importing Web Data into Access Table

[anandmr]

Hi,

I would like to access web(internet) using query/URL for some data and import the results to an Access table using VBA.

Could somebody guide me in this to any posts that has already been posted or new replies is also very much appreciated.

Thanks & Regards
Anand

 

[MarkK]

Search this forum for 'Screen Scrape'

 

[ugly]

Maybe this can help You. Good luck.

Public Function GetTag(strText As String, strTag As String, strTagEnd As String, strControlLine As String) As String
Dim intStart As Long
Dim intEnd As Long
Dim intControlLine As Long
intControlLine = strControlLine
'
' Look for where the Tag starts
' If not found return an empty string
'
intStart = InStr(1, strText, strTag)
If intStart = 0 Then
   GetTag = ""
   Exit Function
End If
'
' The data value lies "after" the text (strTag)
'
intStart = intStart + Len(strTag)
'
' The end of the data is "before" the carrige return (strTagEnd)
'
intEnd = InStr(intStart, strText, strTagEnd)
'Gets the Postalnumber. It starts after carrige return. 4 numbers.
If intControlLine = "3" Then
  intStart = intEnd
  GetTag = Mid(strText, intStart + 2, 4)
End If
If intControlLine = "0" Then
  GetTag = Mid(strText, intStart, intEnd - intStart)
End If
End Function
 
Private Sub btnSearch_Click()
    Me.FocusBox.SetFocus
    Me.btnSearch.Enabled = False
    Me.btnSearch.Caption = "Henter data..."
    Me!WebBrowser0.Navigate "[URL]http://w2.brreg.no/enhet/sok/detalj.jsp?orgnr[/URL]=" & Me.OrgNr
End Sub
 
Private Sub WebBrowser0_Updated(Code As Integer)
    Dim Text As String
    Dim vReadyState 'check if page is fully loaded. 4 = loaded
    vReadyState = 0
    Do Until vReadyState = 4
      DoEvents
      vReadyState = Me!WebBrowser0.ReadyState
    Loop
 
 
  If vReadyState = 4 Then
    On Error Resume Next
    Text = WebBrowser0.Document.Body.InnerText
    Me.Results = Text
    'MsgBox Me.Results
    Me.btnSearch.Caption = "Søk..."
    Me.btnSearch.Enabled = True
    Me.Firmanavn = GetTag(Me.Results, "Navn/foretaksnavn:", Chr(13), "0")
    Me.Postadresse = GetTag(Me.Results, "Forretningsadresse:", Chr(13), "0")
    Me.KontaktPerson = GetTag(Me.Results, "Daglig leder/ adm.direktør:", Chr(13), "0")
    Me.Postnummer = GetTag(Me.Results, "Forretningsadresse:", Chr(13), "3")
    If Not IsNull(Me.Postnummer) Then
      Me.Poststed = Nz(DLookup("Psted", "Postnummer", "[Pnr] = '" & Me.Postnummer & "'"), "Feil Postnummer")
       If Me.Poststed = "Feil Postnummer" Then
         MsgBox "Du har tastet inn et POSTNUMMER som ikke eksisterer." & vbCrLf & vbCrLf & "Se bort fra denne meldingen hvis det er et utenlandsk Postnummer.", 64, "Feil Postnummer?"
       End If
    End If
    Me.Epostadresse.SetFocus
  End If
End Sub

 

[anandmr]

Thanks a lot for the reply.

It would be very help ful if you can elighten me on the usgae of the above code and also help in choosing the references etc. I am new to Access VBA programming.

Thanks again and your help is very much apprecaited.

Regards
Anand