SCAN to Excel Auto-Scraper Rumba Script

Sub Main
    Dim ScreenText As String
    Dim Row As Integer
    Dim Area As Integer
    Dim BottomText1 As String
    Dim BottomText2 As String
    Dim Bottom As Boolean
    Dim xlRow As Long
    
    ' --- EXCEL OBJECTS ---
    Dim xlApp As Object
    Dim xlBook As Object
    Dim xlSheet As Object

    ' --- FILE PATH CONFIGURATION ---
    Dim fullPath As String
    fullPath = "Y:\Reports Administation\Daily Reports\Layup Status\Old\Layup Status Report Excel.xlsx"

    ' --- AREA CODES (0 to 28 = 29 Areas) ---
    Dim ArrayEA$ (28)
    ArrayEA(0) = "CF "
    ArrayEA(1) = "CF1 "
    ArrayEA(2) = "GIFT "
    ArrayEA(3) = "LUDAR"
    ArrayEA(4) = "LUDBB"
    ArrayEA(5) = "LUDFE"
    ArrayEA(6) = "LUDME"
    ArrayEA(7) = "LUDFW"
    ArrayEA(8) = "LUDMW"
    ArrayEA(9) = "LUDG "
    ArrayEA(10) = "LUDNC"
    ArrayEA(11) = "LUDS "
    ArrayEA(12) = "LUDSR"
    ArrayEA(13) = "LURAR"
    ArrayEA(14) = "LURBB"
    ArrayEA(15) = "LURFE"
    ArrayEA(16) = "LURME"
    ArrayEA(17) = "LURFW"
    ArrayEA(18) = "LURMW"
    ArrayEA(19) = "LURG "
    ArrayEA(20) = "LURNC"
    ArrayEA(21) = "LURS "
    ArrayEA(22) = "LURXL"
    ArrayEA(23) = "PENNY"
    ArrayEA(24) = "LUDST"
    ArrayEA(25) = "LURST"
    ArrayEA(26) = "SHOES"
    ArrayEA(27) = "CFE "
    ArrayEA(28) = "CFW "

    ' 1. HOOK OR OPEN THE EXCEL WORKBOOK
    On Error Resume Next
    Set xlBook = GetObject(fullPath)
    On Error GoTo 0

    If xlBook Is Nothing Then
        MsgBox "Failed to open Excel file! Please check path:" & Chr(13) & fullPath, 16, "File Error"
        Exit Sub
    End If

    Set xlApp = xlBook.Application
    xlApp.Visible = True
    Set xlSheet = xlBook.Sheets(1)

    ' Starts writing at Row 2 in Excel
    xlRow = 2

    ' 2. NAVIGATE MENUS IN SCAN (With timing delays)
    EMSendKey "<Tab>"
    EMSendKey "mm"
    EMSendKey "<Enter>"
    SafeWait 0.5
    
    EMSendKey "2"
    EMSendKey "<Enter>"
    SafeWait 0.5
    
    EMSendKey "1"
    EMSendKey "<Enter>"
    SafeWait 0.5

    ' 3. LOOP THROUGH ALL AREAS
    For Area = 0 To 28
        EMSetCursor 3, 64
        EMSendKey ArrayEA(Area)
        EMSendKey "<Enter>"
        
        ' Give AS400 0.6 seconds to pull the query results
        SafeWait 0.6

        Bottom = True
        While Bottom
            
            ' A. Read the 24 lines and send straight to Excel
            For Row = 1 To 24
                EMReadScreen ScreenText, 80, Row, 1
                
                ' Only write non-blank lines
                If Trim(ScreenText) <> "" Then
                    xlSheet.Cells(xlRow, 1).Value = ScreenText
                    xlRow = xlRow + 1
                End If
            Next Row

            ' B. Check end of data indicators
            EMReadScreen BottomText1, 1, 10, 75
            EMReadScreen BottomText2, 6, 24, 32

            If BottomText1 = " " Or LCase(Trim(BottomText2)) = "bottom" Then
                Bottom = False
            Else
                ' C. Page Down to next screen
                EMSendKey "<Page_Down>"
                
                ' Synchronization delay (eliminates skipped lines)
                SafeWait 0.4
            End If
        Wend
    Next Area

    ' Auto-fit column A in Excel
    xlSheet.Columns("A:A").EntireColumn.AutoFit

    MsgBox "Import Complete! Total lines written to Excel: " & (xlRow - 2), 64, "Process Complete"
End Sub

' -----------------------------------------------------------------------------
' UNIVERSAL DELAY FUNCTION: Uses pure Basic keywords
' -----------------------------------------------------------------------------
Sub SafeWait(Seconds As Single)
    Dim targetTime As Single
    targetTime = Timer + Seconds
    While Timer < targetTime
    Wend
End Sub