Changing a an Excel Screen Scrape to An MS Access Screen Scrape

#1 (**permalink**) 28-Jul-2006, 08:41 AM

Hi, I recently wrote a Screen Scrape for Microsoft Excel, but now my
job requires me to change the same Screen Scrape Macro into an MS
Access Screen Scrape. I want it to dump into a table in Access so I can
query and run reports off of the information. I'm not sure of the
syntax that needs to be used in MS Access that will make it do the same
things the program is currently doing in Excel. Any help is well
appreciated. Below is some of the code that dumps the screen scrape
data into a spreadsheet currently. Thanks

Sub ReadEmpData()
Dim x As Integer

wsDailyInfo.Activate

Do
For x = 1 To 6
If Trim(hsTKS.Screen.GetString(8 + 2 * x, 3, 15)) = "" Then
Exit For
Else

wsDailyInfo.Range("A3:A33").Find(Trim(hsTKS.Screen.GetString(8 + 2 * x,
3, 15))).Activate

'If employee not found
If Selection.Value <> Trim(hsTKS.Screen.GetString(8 + 2
* x, 3, 15)) Then
strMissingEmployees = strMissingEmployees & Chr(13)
& _
Trim(hsTKS.Screen.GetString(8 + 2 * x,
3, 15))
Else
If Trim(hsTKS.Screen.GetString(8 + 2 * x, 52, 4)) =
"" Then
Selection.Offset(0, 4) = 0
Selection.Offset(0, 5) =
Trim(hsTKS.Screen.GetString(8 + 2 * x, 69, 2))
Else
Selection.Offset(0, 4) = HoursWorking(8 + 2 *
x)
If Trim(hsTKS.Screen.GetString(8 + 2 * x, 69,
2)) <> "" Then
Selection.Offset(0, 5) =
Trim(hsTKS.Screen.GetString(8 + 2 * x, 69, 2))
Else
Selection.Offset(0, 5) = ""
End If
End If

End If

End If

Next x

If Trim(hsTKS.Screen.GetString(22, 3, 11)) = "" Then
hsTKS.Screen.SendKeys ""
hsTKS.WaitForHost
ElseIf hsTKS.Screen.GetString(22, 3, 11) = "END OF DATA" Then
Reference:: Sikh Philosophy Network http://www.sikhphilosophy.net/information-technology/13879-changing-excel-screen-scrape-ms-access.html
Exit Do
Else
Err.Raise 1, "ReadEmpData", "Unexpected TKS Responce! (" &
hsTKS.Screen.GetString(22, 3, 11) & ")"
End If
Loop

End Sub

***************************Below here is the actual Screen
Scrape******************************

Option Explicit
Dim hsGMTKS_4tks As HostSession, strMissingEmployees As String

Function hsTKS() As HostSession

If hsGMTKS_4tks Is Nothing Then
Set hsGMTKS_4tks = New HostSession
hsGMTKS_4tks.SelectSession Range("SessionName")
hsGMTKS_4tks.TimeoutValue = Range("TimeOut")
hsGMTKS_4tks.HostSettleTime = Range("SettleTime")
End If

Set hsTKS = hsGMTKS_4tks

End Function

Sub ScanTKSCodes(DateToScan As Date)
Dim rCodes As Range, rDest As Range

'Check that DateToScan is no older then Monday of Previous Week
If DateToScan < CLng(Now) - Weekday(Now(), vbMonday) - 7 Then
Err.Raise 1, "ScanTKSCodes", "Date selected (" &
Format(DateToScan, "mm/dd/yy") & ") is older then Previous Week."
End If

Set rCodes = wsSetUp.Range("rTKSDepts").Cells(1, 1)

strMissingEmployees = ""

Do Until rCodes.Value = ""

NavToTimeAndAttd
hsTKS.Screen.PutString "D", 16, 19
Select Case Weekday(DateToScan)
Case 1
hsTKS.Screen.PutString "SUN", 19, 27
Case 2
hsTKS.Screen.PutString "MON", 19, 27
Case 3
hsTKS.Screen.PutString "TUE", 19, 27
Case 4
hsTKS.Screen.PutString "WED", 19, 27
Case 5
hsTKS.Screen.PutString "THU", 19, 27
Case 6
hsTKS.Screen.PutString "FRI", 19, 27
Case 7
hsTKS.Screen.PutString "SAT", 19, 27
End Select
' Current or Previous
If DateToScan < CLng(Now() - Weekday(Now(), vbMonday)) Then
hsTKS.Screen.PutString "P", 19, 60
Else
hsTKS.Screen.PutString "C", 19, 60
End If
hsTKS.Screen.PutString rCodes, 18, 28
hsTKS.Screen.PutString wsControl.Range("Shift"), 18, 46
hsTKS.EnterAndWait

ReadEmpData

Set rCodes = rCodes.Offset(1, 0)
Loop

If strMissingEmployees <> "" Then
Reference:: Sikh Philosophy Network http://www.sikhphilosophy.net/showthread.php?t=13879
MsgBox "The following employees are on TKS but not on the Daily
Info sheet: " & _
Chr(13) & strMissingEmployees, vbExclamation, "Scan TKS"
End If