VB Script для цикла данных Excel по строке

Я работаю над сценарием VB, который извлекает данные из Excel и вводит их на экран в мейнфрейме IBM 3270. С помощью приведенного ниже кода я могу открыть книгу Excel и скопировать данные по ячейкам, а затем ввести значение из выбранной ячейки на экран 3270, используя определенные мной процедуры subEnterData и subMovecursor. Работает отлично. Но, как вы можете видеть из моего кода ниже, я собираю данные только из ячеек, расположенных в строке 2 объекта Excel (строка 1 - заголовки). Мне нужно получить данные из каждой ячейки в каждой строке, а затем перейти к следующей строке. Итак, после завершения строки 2 мне нужно перейти к строке 3, перейти к каждой ячейке в строке 3, скопировать данные из каждой ячейки и вставить их на экран в 3270, затем то же самое со строкой 4 и так далее. Их около 50 рядов, но их может быть больше или меньше.

Ниже приводится основная часть кода:

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

В subStringExcelData вы можете видеть, что я вызываю объект и получаю значение:

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

Затем я использую subDoWork, чтобы найти правильное местоположение на экране 3270 и вставить значение в правильное местоположение. Это прекрасно работает, но мне нужно иметь возможность делать это со многими строками, и, как я это сделал, в настоящее время я могу получить только одну строку за раз. Пожалуйста помоги!

Sub subDelpScreen содержит триггер для запуска 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

1 ответ

Решение

Не завершено или каким-либо образом проверено, но должно дать вам некоторое представление о том, как действовать:

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
Другие вопросы по тегам