VB 循环脚本 Excel 按行数据

Question

我正在编写一个 VB 脚本，该脚本从 Excel 获取数据并将其输入到 IBM 3270 大型机的屏幕中。使用下面的代码，我可以打开 excel 工作簿并按单元格复制数据，然后使用我定义的 subEnterData 和 subMovecursor 过程将所选单元格的值输入到 3270 屏幕。它很管用。但是正如您从我下面的代码中看到的那样，我只从位于 excel object 的第 2 行的单元格中获取数据（第 1 行是 headers）。我需要从每一行中的每个单元格中获取数据，然后移至下一行。因此，在第 2 行完成后，我需要移动到第 3 行，转到第 3 行中的每个单元格，从每个单元格复制数据并将其粘贴到 3270 中的屏幕，然后与第 4 行相同，依此类推。它们大约有 50 行，但可能更多或更少。

下面是主要的body代码：

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:\Scripting11_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 中看到，我正在调用 object 并获取值：

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

Answer 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:\Scripting11_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 循环脚本 Excel 按行数据

VB Script To Loop Excel Data by Row

excel

loops

vbscript

3270