Question

我正在研究一个VB脚本，该脚本从Excel抓取数据并将其输入到IBM 3270大型机内的屏幕中。使用下面的代码，我可以打开excel工作簿并按单元格复制数据，然后使用我定义的subEnterData和subMovecursor过程将所选单元格中的值输入3270屏幕。它很棒。但是正如您从下面的代码中看到的那样，我仅从excel对象第2行中的单元格中获取数据（第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

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

1 个答案: