Welcome to SPN

Register and Join the most happening forum of Sikh community & intellectuals from around the world.

Sign Up Now!

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

Discussion in 'Information Technology' started by blackmanofsteel40@gmail.com, Jul 28, 2006.

  1. blackmanofsteel40@gmail.com

    blackmanofsteel40@gmail.com
    Expand Collapse
    Guest

    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 "<PF8>"
    hsTKS.WaitForHost
    ElseIf hsTKS.Screen.GetString(22, 3, 11) = "END OF DATA" Then
    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
    MsgBox "The following employees are on TKS but not on the Daily
    Info sheet: " & _
    Chr(13) & strMissingEmployees, vbExclamation, "Scan TKS"
    End If
     
  2. Loading...

    Similar Threads Forum Date
    S Asia Thinking about the big move: The Sikh way of life changing in Khyber-Pakhtunkhwa Breaking News Mar 22, 2014
    Opinion Haanji's Quick Takes on a Changing World (September 23, 2013) Breaking News Sep 22, 2013
    Changing my last name to Kaur... Questions and Answers May 15, 2013
    Life-changing Inspirational Stories Mar 31, 2013
    USA Sikhism and the Changing Electoral Demographic Breaking News Mar 8, 2013

Share This Page