DWUTKA at marlow.com
DWUTKA at marlow.com
Wed Jan 28 15:33:21 CST 2004
John, I wrote some code that that PUSHES data to a web page, but it would be
a simple matter of reversing the process (sort of) to read data from the
web. Here's the module I wrote to do that:
Option Compare Database
Public KatIE As InternetExplorer
Function CheckForNull(strTemp)
If IsNull(strTemp) Then
CheckForNull = ""
Else
CheckForNull = strTemp
End If
End Function
Function OpenKatExplorer()
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open "tblDefaultURL", CurrentProject.Connection, adOpenKeyset,
adLockReadOnly
rs.MoveFirst
Set KatIE = Nothing
Set KatIE = GetObject("", "InternetExplorer.Application")
KatIE.Visible = True
KatIE.Navigate rs.Fields(0).Value
rs.Close
Set rs = Nothing
End Function
Function SetKatData(strKey As String)
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rs As Recordset
Dim rsTemp As Recordset
Dim itm
Dim tmpDate As Date
Dim intMonth As Long
Dim intYear As Long
strSQL = "SELECT tblSORM_TWCC1S.I_strLastName,
tblSORM_TWCC1S.I_strMiddleName, tblS" & _
"ORM_TWCC1S.I_strFirstName, tblSORM_TWCC1S.I_strSex,
tblSORM_TWCC1S.I_strSocialSecu" & _
"rityNumber, tblSORM_TWCC1S.I_strHomePhone,
tblSORM_TWCC1S.I_strWorkPhoneNumber, tb" & _
"lSORM_TWCC1S.P_logSpeakEnglish, tblSORM_TWCC1S.I_strStreetAddress1,
tblSORM_TWCC1S" & _
".I_strStreetAddress2, tblSORM_TWCC1S.I_strCity, tblSORM_TWCC1S.P_strCounty,
tblSOR" & _
"M_TWCC1S.I_strZipCode, tblSORM_TWCC1S.IM_memIncidentDescription,
tblSORM_TWCC1S.I_" & _
"strWorksiteLocation, tblSORM_TWCC1S.I_strSiteName,
tblSORM_TWCC1S.S_strAddress1, t" & _
"blSORM_TWCC1S.S_strCounty, tblSORM_TWCC1S.S_strCity,
tblSORM_TWCC1S.S_strState, tb" & _
"lSORM_TWCC1S.S_strZipCode, tblSORM_TWCC1S.IM_memWitnesses,
tblSORM_TWCC1S.I_logDea" & _
"th, tblSORM_TWCC1S.I_strSupervisorNotified,
tblSORM_TWCC1S.I_dtmNotifiedOfIncident" & _
", tblSORM_TWCC1S.P_logRecruitedInState,
tblSORM_TWCC1S.P_strJobClassification, tbl" & _
"SORM_TWCC1S.II_intHourPerDay, tblSORM_TWCC1S.II_curWagePerWeek,
tblSORM_TWCC1S.SORM" & _
"_curLastPayCheck, tblSORM_TWCC1S.II_intDayPerWeek,
tblSORM_TWCC1S.P_strMarried, t" & _
"blSORM_TWCC1S.P_intNumberOfDependents, tblSORM_TWCC1S.P_strSpouseName ,
tblSORM_TW" & _
"CC1S.I_strDoctorName, tblSORM_TWCC1S.D_strPhone,
tblSORM_TWCC1S.D_strStreetAddress" & _
"1, tblSORM_TWCC1S.D_strCity, tblSORM_TWCC1S.D_strState,
tblSORM_TWCC1S.D_strZipCod" & _
"e, tblSORM_TWCC1S.I_dtmIncidentDate, tblSORM_TWCC1S.I_dtmIncidentTime,
tblSORM_TWC" & _
"C1S.C_strAddress1, tblSORM_TWCC1S.C_strPhone, tblSORM_TWCC1S.C_strCity,
tblSORM_TW" & _
"CC1S.C_strState, tblSORM_TWCC1S.C_strZipCode,
tblSORM_TWCC1S.C_strFederalTaxNumber" & _
", tblSORM_TWCC1S.C_strSICStandard, tblSORM_TWCC1S.C_strSICSpecific,
tblSORM_TWCC1S" & _
".P_strPayCode, tblSORM_TWCC1S.P_dtmDateOfHire, tblSORM_TWCC1S.P_dtmDateOf"
& _
"Birth, tblSORM_TWCC1S.P_strLanguage, tblSORM_TWCC1S.LD_dtmFirstLostDay,
tblSORM_T" & _
"WCC1S.JobCompare, tblSORM_TWCC1S.I_dtmDateBackToWork,
tblSORM_TWCC1S.Sorm_intLenOc" & _
"cYears, tblSORM_TWCC1S.Sorm_intLenOccMonths,
tblSORM_TWCC1S.Sorm_logacci_prevent_r" & _
"eq, tblSORM_TWCC1S.Sorm_logacci_prevent_received,
tblSORM_TWCC1S.Sorm_logOwner, "
strSQL = strSQL & "tblSORM_TWCC1S.Sorm_intSickHours, tblSORM_TWCC1S" & _
".Sorm_intAnnualLeave, tblSORM_TWCC1S.P_strLanguage,
tblSORM_TWCC1S.I_strState, t" & _
"blSORM_TWCC1S.P_strCounty, tblSORM_TWCC1S.C_strPersonCompletingFormName" &
_
", tblSORM_TWCC1S.C_strPersonCompletingFormJobTitle,
tblSORM_TWCC1S.Sorm_strAgencyLocationCode" & _
", tblSORM_TWCC1S.Sorm_logacci_prevent_req,
tblSORM_TWCC1S.Sorm_logacci_prevent_received " & _
"FROM tblSORM_TWCC1S " & _
"WHERE (((tblSORM_TWCC1S.pkCaseNumber)=""" & strKey & """));"
Set rs = New ADODB.Recordset
rs.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
If rs.EOF = False Then
rs.MoveFirst
With KatIE.Document.theForm
.lastname.Value = CheckForNull(rs.Fields(0).Value)
.middlename.Value = CheckForNull(rs.Fields(1).Value)
.firstname.Value = CheckForNull(rs.Fields(2).Value)
Select Case UCase(Left(CheckForNull(rs.Fields(3).Value), 1))
Case "F"
.gender(0).Checked = True
Case "M"
.gender(1).Checked = True
End Select
.SSN.Value = CheckForNull(rs.Fields(4).Value)
.homephone.Value = CheckForNull(rs.Fields(5).Value)
.employeephone.Value = CheckForNull(rs.Fields(6).Value)
If rs.Fields(7).Value = True Then
.english(0).Checked = True
Else
.english(1).Checked = True
.language.Value = CheckForNull(rs.Fields(64).Value)
End If
.mail_address1.Value = CheckForNull(rs.Fields(8).Value)
.mail_address2.Value = CheckForNull(rs.Fields(9).Value)
.mail_city.Value = CheckForNull(rs.Fields(10).Value)
For Each itm In .mail_county.options
If Trim(UCase(Mid(itm.Text, 5))) =
Trim(UCase(CheckForNull(rs.Fields(11).Value))) Then
itm.Selected = True
Exit For
End If
Next
.mail_zip.Value = CheckForNull(rs.Fields(12).Value)
.mail_state.Value = CheckForNull(rs.Fields(65).Value)
.occurred_how.Value = CheckForNull(rs.Fields(13).Value)
.injury_location.Value = CheckForNull(rs.Fields(14).Value)
.site_address_name.Value = CheckForNull(rs.Fields(15).Value)
.site_street.Value = CheckForNull(rs.Fields(16).Value)
For Each itm In .site_county.options
If Trim(UCase(Mid(itm.Text, 5))) =
Trim(UCase(CheckForNull(rs.Fields(17).Value))) Then
itm.Selected = True
Exit For
End If
Next
.site_city.Value = CheckForNull(rs.Fields(18).Value)
.site_state.Value = CheckForNull(rs.Fields(19).Value)
.site_zip.Value = CheckForNull(rs.Fields(20).Value)
.witnesses.Value = CheckForNull(rs.Fields(21).Value)
If rs.Fields(22).Value = True Then
.emp_death(0).Checked = True
Else
.emp_death(1).Checked = True
End If
.supervisor_name.Value = CheckForNull(rs.Fields(23).Value)
.report_date.Value = Format(CheckForNull(rs.Fields(24).Value),
"mm/dd/yyyy")
If CheckForNull(rs.Fields(25).Value) = True Then
.tx_recruit(0).Checked = True
Else
.tx_recruit(1).Checked = True
End If
.injured_occupy.Value = CheckForNull(rs.Fields(26).Value)
.pay_rate.Value = CheckForNull(rs.Fields(28).Value)
.pay_frequency.Value = "W"
.full_week_hours.Value = rs.Fields(27).Value * rs.Fields(30).Value
.last_paycheck.Value = Format(CheckForNull(rs.Fields(29).Value),
"#,##0.00")
.full_week_days.Value = CheckForNull(rs.Fields(30).Value)
For Each itm In .marital_status.options
If Trim(UCase(itm.Text)) =
Trim(UCase(CheckForNull(rs.Fields(31).Value))) Then
itm.Selected = True
Exit For
End If
Next
.kid_number.Value = CheckForNull(rs.Fields(32).Value)
.spouse_name.Value = CheckForNull(rs.Fields(33).Value)
.doctor_name.Value = CheckForNull(rs.Fields(34).Value)
.doctor_phone.Value = Format(CheckForNull(rs.Fields(35).Value),
"000-000-0000")
.doctor_street.Value = CheckForNull(rs.Fields(36).Value)
.doctor_city.Value = CheckForNull(rs.Fields(37).Value)
.doctor_state.Value = CheckForNull(rs.Fields(38).Value)
.doctor_zip.Value = CheckForNull(rs.Fields(39).Value)
.injury_date.Value = Format(CheckForNull(rs.Fields(40).Value),
"mm/dd/yyyy")
.injury_time.Value = Left(Format(CheckForNull(rs.Fields(41).Value),
"hh:nnAMPM"), 5)
If Hour(CheckForNull(rs.Fields(41).Value)) >= 12 Then
.injury_AMPM(1).Checked = True
Else
.injury_AMPM(0).Checked = True
End If
.agency_mail_address.Value = CheckForNull(rs.Fields(42).Value)
.agency_phone.Value = Format(CheckForNull(rs.Fields(43).Value),
"000-000-0000")
.agency_city.Value = CheckForNull(rs.Fields(44).Value)
.agency_state.Value = CheckForNull(rs.Fields(45).Value)
.agency_zip.Value = CheckForNull(rs.Fields(46).Value)
.fed_id_num.Value = CheckForNull(rs.Fields(47).Value)
.pSIC.Value = CheckForNull(rs.Fields(48).Value)
.sSIC.Value = CheckForNull(rs.Fields(49).Value)
.payroll_class_code.Value = CheckForNull(rs.Fields(50).Value)
.hire_date.Value = Format(CheckForNull(rs.Fields(51).Value),
"mm/dd/yyyy")
.birth_date.Value = CheckForNull(rs.Fields(52).Value)
.language.Value = CheckForNull(rs.Fields(53).Value)
If IsNull(rs.Fields(54).Value) Then
.loss_date.Value = "NLT"
Else
.loss_date.Value = Format(rs.Fields(54).Value, "mm/dd/yyyy")
End If
If UCase(CheckForNull(rs.Fields(55).Value)) = "YES" Then
.normal_job(0).Checked = True
Else
.normal_job(1).Checked = True
End If
.return_date.Value = Format(CheckForNull(rs.Fields(56).Value),
"mm/dd/yyyy")
.occupy_years.Value = CheckForNull(rs.Fields(57).Value)
.occupy_months.Value = CheckForNull(rs.Fields(58).Value)
If rs.Fields(59).Value = True Then
.accident_prevent_req_receive(0).Checked = True
Else
.accident_prevent_req_receive(1).Checked = True
End If
If rs.Fields(60).Value = True Then
.accident_prevent_req_resolve(0).Checked = True
Else
.accident_prevent_req_resolve(1).Checked = True
End If
If rs.Fields(61).Value = True Then
.officer(0).Checked = True
Else
.officer(1).Checked = True
End If
.injury_cause.Value = CheckForNull(rs.Fields(62).Value)
.sick_leave.Value = CheckForNull(rs.Fields(62).Value)
.annual_leave.Value = CheckForNull(rs.Fields(63).Value)
.completing_name.Value = CheckForNull(rs.Fields(67).Value)
.completing_title.Value = CheckForNull(rs.Fields(68).Value)
.agency_lcode1.Value = CheckForNull(rs.Fields(69).Value)
If rs.Fields(70).Value = True Then
.accident_prevent_req_receive(0).Checked = True
Else
.accident_prevent_req_receive(1).Checked = True
End If
If rs.Fields(71).Value = True Then
.accident_prevent_req_resolve(0).Checked = True
Else
.accident_prevent_req_resolve(1).Checked = True
End If
Set rsTemp = New ADODB.Recordset
strSQL = "SELECT tblSORM_NatureOfInjury.SormN_strDescription " & _
"FROM tblSORM_NatureOfInjury " & _
"WHERE (((tblSORM_NatureOfInjury.SormN_fk_CaseNumber)=""" & strKey &
"""));"
rsTemp.Open strSQL, CurrentProject.Connection, adOpenKeyset,
adLockReadOnly
If rsTemp.EOF = False Then rs.MoveFirst
Do Until rsTemp.EOF = True
For Each itm In .injury_nature.options
If Trim(UCase(itm.Text)) =
Trim(UCase(rsTemp.Fields(0).Value)) Then
itm.Selected = True
Exit For
End If
Next
rsTemp.MoveNext
Loop
rsTemp.Close
Set rsTemp = Nothing
Set rsTemp = New ADODB.Recordset
strSQL = "SELECT tblSORM_BodyPart.SormBDY_strDescription " & _
"FROM tblSORM_BODYPart " & _
"WHERE (((tblSORM_BodyPart.SormBDY_fk_CaseNumber)=""" & strKey &
"""));"
rsTemp.Open strSQL, CurrentProject.Connection, adOpenKeyset,
adLockReadOnly
If rsTemp.EOF = False Then rs.MoveFirst
Do Until rsTemp.EOF = True
For Each itm In .part_injured.options
If Trim(UCase(itm.Text)) =
Trim(UCase(rsTemp.Fields(0).Value)) Then
itm.Selected = True
Exit For
End If
Next
rsTemp.MoveNext
Loop
rsTemp.Close
Set rsTemp = Nothing
Set rsTemp = New ADODB.Recordset
strSQL = "SELECT tblSORM_Cause.SormCS_strDescription " & _
"FROM tblSORM_Cause " & _
"WHERE (((tblSORM_Cause.SormCS_fk_CaseNumber)=""" & strKey & """));"
rsTemp.Open strSQL, CurrentProject.Connection, adOpenKeyset,
adLockReadOnly
If rsTemp.EOF = False Then rs.MoveFirst
Do Until rsTemp.EOF = True
For Each itm In .injury_cause.options
If Trim(UCase(itm.Text)) =
Trim(UCase(rsTemp.Fields(0).Value)) Then
itm.Selected = True
Exit For
End If
Next
rsTemp.MoveNext
Loop
rsTemp.Close
Set rsTemp = Nothing
tmpDate = CheckForNull(rs.Fields(51).Value)
intMonth = 0
intYear = 0
tmpDate = tmpDate + (365.25 / 12)
Do Until tmpDate >= rs.Fields(40).Value
intMonth = intMonth + 1
If intMonth = 12 Then
intMonth = 0
intYear = intYear + 1
End If
tmpDate = tmpDate + (365.25 / 12)
Loop
.pos_service_years.Value = intYear
.pos_service_months.Value = intMonth
End With
MsgBox "Done"
Else
MsgBox "No Data for this case number.", vbOKOnly + vbCritical, "No Data"
End If
rs.Close
Set rs = Nothing
Exit Function
ErrorHandler:
MsgBox "Data Upload failed."
Err.Clear
End Function
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com]On Behalf Of John W. Colby
Sent: Wednesday, January 28, 2004 1:03 PM
To: AccessD
Subject: [AccessD] Getting internet data
I need to get some internet data into a db. In order to do that I need to
"navigate", specifically I have to enter a username / password which will
bring me to a specific page. After that clicking on tabs at the top take me
to other pages I'd also like to get data off of.
Does anyone know how to do this from VBA?
John W. Colby
www.ColbyConsulting.com
_______________________________________________
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com