VB Script To Loop Excel Data by Row

Question

I am working on a VB script that grabs data from Excel and inputs it into a screen within an IBM 3270 mainframe. With the code below, I am able to open the excel workbook and copy the data by cell and then input the value from the cell chosen into the 3270 screen using subEnterData and subMovecursor procedures that I've defined. It works greats. But as you can see from my code below that I am only grabbing data from the cells located in Row 2 of the excel object (Row 1 is headers). I need to grab data from each cell within each row and then move to the next Row. So, after Row 2 is finished, I need to move to Row 3, go to each cell within Row 3, copy data from each cell and paste it to a screen in 3270, then the same with Row 4 and so on. They're about 50 Rows, but there could be more or less.

Below is the main body of the code:

Option Explicit
Dim objExcel, objExcel1, objExcel2
Dim atlDirectorObject, oFileObject
Dim atl3270Tool 
Dim oMstrCmp 
Dim ErrMsg
'---------------------Excel Column Placement
Dim strLoanNumber_3_7
Dim strFlag_11_5
Dim strDate_11_10 
Dim strINV_11_21
Dim strCAT_11_27
Dim strEBalance_11_53
Dim strLPIDate_11_35
Dim strNewLoanNumber_11_68
Dim strServiceFee_16_7
Dim strADDLInvstor_21_66
Dim strRemitCTRL_11_76
Dim strINVBalance_13_68
'---------------------Excel Column Placement
Set atlDirectorObject = CreateObject("atlDirectorObject.atlDirector")
Set oFileObject       = CreateObject("Scripting.FileSystemObject")
Set objExcel          = createobject("Excel.Application")
Set objExcel1         = 
objExcel.Workbooks.Open("S:\Scripting\0711_Settlement2.xlsx")
Set objExcel2         = objExcel1.Worksheets("Import")

subGetSession
subDelpScreen

'objExcel1.Close
'objExcel.Quit
 Set objExcel          = Nothing
 Set objExcel1         = Nothing
 Set objExcel2         = Nothing
 Set atlDirectorObject = Nothing
 Set oFileObject       = Nothing
 Set atl3270Tool       = Nothing

You can see in subStringExcelData, that I am invoking the object and getting the value:

Sub subStringExcelData
objExcel.Visible = True
strLoanNumber_3_7       = objExcel1.Worksheets("Import").Cells(2,1).Value
strFlag_11_5            = objExcel1.Worksheets("Import").Cells(2,2).Value
strDate_11_10           = objExcel1.Worksheets("Import").Cells(2,3).Value
strINV_11_21            = objExcel1.Worksheets("Import").Cells(2,4).Value
strCAT_11_27            = objExcel1.Worksheets("Import").Cells(2,5).Value
strLPIDate_11_35        = objExcel1.Worksheets("Import").Cells(2,6).Value
strEBalance_11_53       = objExcel1.Worksheets("Import").Cells(2,7).Value
strNewLoanNumber_11_68  = objExcel1.Worksheets("Import").Cells(2,8).Value
strServiceFee_16_7      = objExcel1.Worksheets("Import").Cells(2,9).Value
strADDLInvstor_21_66    = objExcel1.Worksheets("Import").Cells(2,10).Value
strRemitCTRL_11_76      = objExcel1.Worksheets("Import").Cells(2,11).Value
strINVBalance_13_68      = objExcel1.Worksheets("Import").Cells(2,12).Value
End Sub

Then I am using subDoWork, to find the right location on the 3270 screen and paste the value in the correct location. It works great, but I need to be able to do this with many rows and the way I have done this, I can currently only get one row at a time. Please Help!

Sub subDelpScreen holds the trigger to run subDoWork.

Sub subDoWork
subClearScreen
subGoToScreen "DELP", "********", ""
subStringExcelData
'subPressKey "@E"
    subMoveCursor 3, 7 
    subEnterData strLoanNumber_3_7
subPressKey "@E"
    subMoveCursor 11, 5 
    subEnterData strFlag_11_5
    subMoveCursor 11, 10
    subEnterData strDate_11_10
    subMoveCursor 11, 21
    subEnterData strINV_11_21
    subMoveCursor 11, 27
    subEnterData strCAT_11_27
    subMoveCursor 11, 35
    subEnterData strLPIDate_11_35
    subMoveCursor 11, 56
    subEnterData strEBalance_11_53
    subMoveCursor 11, 68
    subEnterData strNewLoanNumber_11_68
    subMoveCursor 13, 71
    subEnterData strINVBalance_13_68
    subMoveCursor 16, 7
    subEnterData strServiceFee_16_7
    subMoveCursor 21, 66
    subEnterData strADDLInvstor_21_66
subPressKey "@E" ' takes you to the second screen
    subMoveCursor 11, 76
    subEnterData strRemitCTRL_11_76
subPressKey "@E"  'Saves the data
End Sub

Seems like you need a loop and also to consider tidying your code up a bit by using method arguments in place of a bunch of globals (partic. the single-use ones - you could pass the data row to subDoWork and it could directly extract the values). — Tim Williams

Tim Williams Tim Williams · Accepted Answer · 2018-07-24T23:31:57

Not complete or in any way tested, but should give you some idea of how to proceed:

Option Explicit

Dim objExcel, objExcelWb, objExcelSht
Dim atlDirectorObject, oFileObject
Dim atl3270Tool
Dim oMstrCmp
Dim ErrMsg

Main

Sub Main()
    Dim rwNum

    Set atlDirectorObject = CreateObject("atlDirectorObject.atlDirector")
    Set objExcel = CreateObject("Excel.Application")
    Set objExcelWb = objExcel.Workbooks.Open("S:\Scripting\0711_Settlement2.xlsx")
    Set objExcelSht = objExcelWb.Worksheets("Import")
    Set oFileObject = CreateObject("Scripting.FileSystemObject")

    rwNum = 2
    'starting at row 2, loop over the dataset until you hit an
    '   empty row (where CountA() = 0)
    Do While objExcel.CountA(objExcelSht.Rows(rwNum)) > 0
        'pass the row of data to subDoWork 
        subDoWork objExcelSht.Rows(rwNum)
        rwNum = rwNum + 1 ' next row...
    Loop

    'typically there's no need to set objects to Nothing unless
    '  there are associated resources you need to free up...
End Sub

Sub subDoWork(rw)
    subClearScreen
    subGoToScreen "DELP", "********", ""

    'subPressKey "@E"

    EnterValueAt 3, 7, rw.Cells(1).Value

    subPressKey "@E"

    EnterValueAt 11, 5, rw.Cells(2).Value
    EnterValueAt 11, 10, rw.Cells(3).Value
    EnterValueAt 11, 21, rw.Cells(4).Value
    'etc
    'etc

    subPressKey "@E" ' takes you to the second screen

    EnterValueAt 11, 76, rw.Cells(11).Value

    subPressKey "@E"  'Saves the data
End Sub

'Enter a value at a given set of coordinates
Sub EnterValueAt(pos1, pos2, v)
    subMoveCursor pos1, pos2
    subEnterData v
End Sub

VB Script To Loop Excel Data by Row

1 Answers