Import data from html to access

[bloodbearer]

hello

I've got a problem and i'm sitting since several weeks at it.

I want to read the information in a html and export it in an accesstable.

this is my code but it didn't run.
Function getAWB2()

'On Error GoTo ErrHdl

Dim strAWB As String
Dim strURL As String
Dim IEApp As Object, IEDoc As Object

If Not IsNull(DLookup("[ID]", "MSysObjects", "[Name]='tblAWBInfo'")) Then
DoCmd.DeleteObject acTable, "tblAWBInfo"
End If

Set tdf = CurrentDb.CreateTableDef
tdf.Name = "tblAWBInfo"
Set fld = tdf.CreateField("strAWB", dbText, 255)
tdf.Fields.Append fld
Set fld = tdf.CreateField("strInfos", dbMemo)
tdf.Fields.Append fld
Set fld = tdf.CreateField("Checkpoint", dbText, 255)
tdf.Fields.Append fld
Set fld = tdf.CreateField("Station", dbText, 255)
tdf.Fields.Append fld
Set fld = tdf.CreateField("Location", dbText, 255)
tdf.Fields.Append fld
Set fld = tdf.CreateField("Date/Time", dbText, 255)
tdf.Fields.Append fld
Set fld = tdf.CreateField("Pcs", dbText, 255)
tdf.Fields.Append fld
Set fld = tdf.CreateField("Route", dbText, 255)
tdf.Fields.Append fld
Set fld = tdf.CreateField("Cycle", dbText, 255)
tdf.Fields.Append fld
Set fld = tdf.CreateField("Stat", dbText, 255)
tdf.Fields.Append fld
Set fld = tdf.CreateField("PgIn", dbText, 255)
tdf.Fields.Append fld
Set fld = tdf.CreateField("Count", dbText, 255)
tdf.Fields.Append fld
Set fld = tdf.CreateField("Last", dbText, 255)
tdf.Fields.Append fld
Set fld = tdf.CreateField("Remarks", dbText, 255)
tdf.Fields.Append fld
Set fld = tdf.CreateField("Comments", dbText, 255)
tdf.Fields.Append fld
CurrentDb.TableDefs.Append tdf
CurrentDb.TableDefs.Refresh

Set rs = CurrentDb.OpenRecordset("tblAWBInfo", dbOpenDynaset)

'strAWB = InputBox("AWB")

Set IEApp = CreateObject("InternetExplorer.Application")
IEApp.Visible = True

Set rsbold = CurrentDb.OpenRecordset("tblAWB", dbOpenSnapshot)
rsbold.MoveFirst


Do Until rsbold.EOF
strURL = "http://npts2.apis.dhl.com:6010/npts/ShipmentDataFetchServlet?action=14&querycriteria=Q UERY_BY_AWB&queryData=" & Trim(rsbold!AWB)
IEApp.Navigate strURL
Do
If UseDoEvents = True Then DoEvents
Loop Until IEApp.Busy = False Or bBreak = True
Set IEDoc = IEApp.Document
Do: Loop Until IEDoc.ReadyState = "complete"

' On Error GoTo ErrHdl1

i = 20
ValNoCP = Trim(Mid(Trim(IEDoc.all.tags("tr").Item(18).innerT ext), InStr(IEDoc.all.tags("tr").Item(18).innerText, "No of Distinct Checkpoints:") + 27, 3))

'MsgBox(valNoCP)

Do Until i > ValNoCP + 19
'MsgBox (i)
strInfos = Trim(IEApp.Document.all.tags("tr").Item(i).innerHT ML)
If strInfos = "" Then
strInfos = " "
End If
rs.AddNew
rs!strAWB = Trim(rsbold!AWB)
rs!strInfos = strInfos
rs.Update
i = i + 1
Loop
rsbold.MoveNext
'ErrHdl1: rsbold.MoveNext

Loop

If IEApp.Visible = True Then
IEApp.Quit
End If

Exit Function
ErrHdl:

MsgBox (Err.Number & ": " & Err.Description)
End Function

Function selectInfo()

Set db = CurrentDb
Set rs = db.OpenRecordset("tblAWBInfo", dbOpenDynaset)
'db.Execute "UPDATE tblAWBInfo SET tblAWBInfo.strInfos = Replace(tblAWBInfo.strInfos,' class=grayTdNormal', '')"
'db.Execute "UPDATE tblAWBInfo SET tblAWBInfo.strInfos = Replace(tblAWBInfo.strInfos,' class=whiteTdNormal', '')"
db.Execute "UPDATE tblAWBInfo SET tblAWBInfo.strInfos = Replace(tblAWBInfo.strInfos,' ', '')"
db.Execute "UPDATE tblAWBInfo SET tblAWBInfo.strInfos = Replace(tblAWBInfo.strInfos,'</A>', '')"
db.Execute "UPDATE tblAWBInfo SET tblAWBInfo.strInfos = Replace(tblAWBInfo.strInfos,'</TD>', '[/E]')"
db.Execute "UPDATE tblAWBInfo SET tblAWBInfo.strInfos = Replace(tblAWBInfo.strInfos,'< TD>', '[/E]')"




rs.MoveFirst


'strng = Mid(strng, _
' InStr(strng, "</2>") + 20, _
' InStr( _
' InStr(strng, "</2>") + 20, _
' strng, _
' "</2>") _
' - InStr(strng, "</2>") + 20)
'Set rs2 = duba

Do Until rs.EOF
Do While InStr(rs!strInfos, "<") > 0
Strng = rs!strInfos
leftstr = Mid(Strng, InStr(Strng, "<"), 3)
Strng = Replace(Strng, _
Mid(Strng, _
InStr(Strng, "<"), _
InStr(Strng, ">") - InStr(Strng, "<") + 1), _
IIf(leftstr = "<A ", "", IIf(leftstr = "<TD", "[B/]", "KAT")), _
1, 1)
rs.Edit
rs!strInfos = Strng
rs.Update
Loop
rs.MoveNext
Loop

db.Execute "UPDATE tblAWBInfo SET tblAWBInfo.strInfos = Replace(tblAWBInfo.strInfos,chr(10), '')"
db.Execute "UPDATE tblAWBInfo SET tblAWBInfo.strInfos = Replace(tblAWBInfo.strInfos,'&gt;','>')"
db.Execute "UPDATE tblAWBInfo SET tblAWBInfo.strInfos = Replace(tblAWBInfo.strInfos,'&lt;','<')"
db.Execute "UPDATE tblAWBInfo SET tblAWBInfo.strInfos = Replace(tblAWBInfo.strInfos,'&amp;','&')"

rs.MoveFirst
Do Until rs.EOF
i = 0 '0
Do Until i > 12 '11
strig = rs!strInfos
strig = Mid(strig, InStr(strig, "[B/]") + 4, InStr(strig, "[/E]") - InStr(strig, "[B/]") - 4)
strig = Trim(strig)
If strig = "" Then
strig = " "
End If
rs.Edit
rs(i + 2) = strig
rs.Update

strug = rs!strInfos
strug = Replace(strug, Left(strug, InStr(strug, "[/E]") + 4), "", 1, 1)
If strug = "" Then
strug = rs!strInfos
End If
rs.Edit
rs!strInfos = strug
rs.Update
i = i + 1
Loop
rs.MoveNext
Loop

rs.Close
db.Close

End Function

I write in the table tblAWB several (10digits long) AWB and the module should export the information for this AWBs from their html site in an access table.

please be so kind and help me.

thanks

[bloodbearer]

please anybody here, help is needed. thanks