Pennygirish
MIS
Hello All,
this is my first post in this forum hope i will get some help here.
Am just breaking my head at setting up a loop in as400
What my macro does is - gets details copied from as400 to excel workbook wherein currently the details are getting overwritten in the same cell instead of jumping to the next cell.
someone please please help on this.
i have attached file as well.
thank you.
[PCOMM SCRIPT HEADER]
LANGUAGE=VBSCRIPT
DESCRIPTION=
[PCOMM SCRIPT SOURCE]
OPTION EXPLICIT
autECLSession.SetConnectionByName(ThisSessionName)
REM This line calls the macro subroutine
subSub1_
sub subSub1_()
Dim ObjExcelAppl, ObjWorkbook, ObjWorksheet
Dim currentRow
Dim StrFileName
Set ObjExcelAppl = CreateObject("Excel.Application")
Set ObjWorkbook = ObjExcelAppl.WorkBooks
StrFileName = "D:\NEW.XLSX"
ObjWorkbook.Open StrFileName
ObjExcelAppl.Visible = True
' Activate first sheet.
ObjExcelAppl.Worksheets(1).Activate
Set ObjWorksheet = ObjExcelAppl.Worksheets(1)
Dim lRow
Dim i
Dim irow
For lRow = 2 To ObjExcelAppl.Worksheets(1).UsedRange.Rows.Count Step 1
For i = 7 to 22
if Trim(autECLSession.autECLPS.Gettext(i,75, 5)) = "OPEN" then
ObjExcelAppl.Worksheets(1).Cells(lRow, 1).Value = Trim(autECLSession.autECLPS.Gettext(i,22,10))
ObjExcelAppl.Worksheets(1).Cells(lRow, 2).Value = Trim(autECLSession.autECLPS.Gettext(i,33,8))
ObjExcelAppl.Worksheets(1).Cells(lRow, 3).Value = Trim(autECLSession.autECLPS.Gettext(i,45,8))
ObjExcelAppl.Worksheets(1).Cells(lRow, 4).Value = Trim(autECLSession.autECLPS.Gettext(i,56,7))
ObjExcelAppl.Worksheets(1).Cells(lRow, 5).Value = Trim(autECLSession.autECLPS.Gettext(i,64,4))
ObjExcelAppl.Worksheets(1).Cells(lRow, 6).Value = Trim(autECLSession.autECLPS.Gettext(i,69,4))
ObjExcelAppl.Worksheets(1).Cells(lRow, 7).Value = Trim(autECLSession.autECLPS.Gettext(i,75,5))
''autECLSession.autECLOIA.WaitForAppAvailable
''autECLSession.autECLOIA.WaitForInputReady
''autECLSession.autECLPS.SendKeys "[roll up]"
''autECLSession.autECLOIA.WaitForAppAvailable
''autECLSession.autECLOIA.WaitForInputReady
Else
End if
Next
Next
''autECLSession.autECLOIA.WaitForAppAvailable
''autECLSession.autECLOIA.WaitForInputReady
ObjExcelAppl.ActiveWorkbook.Save
ObjExcelAppl.DisplayAlerts = True
end sub
this is my first post in this forum hope i will get some help here.
Am just breaking my head at setting up a loop in as400
What my macro does is - gets details copied from as400 to excel workbook wherein currently the details are getting overwritten in the same cell instead of jumping to the next cell.
someone please please help on this.
i have attached file as well.
thank you.
[PCOMM SCRIPT HEADER]
LANGUAGE=VBSCRIPT
DESCRIPTION=
[PCOMM SCRIPT SOURCE]
OPTION EXPLICIT
autECLSession.SetConnectionByName(ThisSessionName)
REM This line calls the macro subroutine
subSub1_
sub subSub1_()
Dim ObjExcelAppl, ObjWorkbook, ObjWorksheet
Dim currentRow
Dim StrFileName
Set ObjExcelAppl = CreateObject("Excel.Application")
Set ObjWorkbook = ObjExcelAppl.WorkBooks
StrFileName = "D:\NEW.XLSX"
ObjWorkbook.Open StrFileName
ObjExcelAppl.Visible = True
' Activate first sheet.
ObjExcelAppl.Worksheets(1).Activate
Set ObjWorksheet = ObjExcelAppl.Worksheets(1)
Dim lRow
Dim i
Dim irow
For lRow = 2 To ObjExcelAppl.Worksheets(1).UsedRange.Rows.Count Step 1
For i = 7 to 22
if Trim(autECLSession.autECLPS.Gettext(i,75, 5)) = "OPEN" then
ObjExcelAppl.Worksheets(1).Cells(lRow, 1).Value = Trim(autECLSession.autECLPS.Gettext(i,22,10))
ObjExcelAppl.Worksheets(1).Cells(lRow, 2).Value = Trim(autECLSession.autECLPS.Gettext(i,33,8))
ObjExcelAppl.Worksheets(1).Cells(lRow, 3).Value = Trim(autECLSession.autECLPS.Gettext(i,45,8))
ObjExcelAppl.Worksheets(1).Cells(lRow, 4).Value = Trim(autECLSession.autECLPS.Gettext(i,56,7))
ObjExcelAppl.Worksheets(1).Cells(lRow, 5).Value = Trim(autECLSession.autECLPS.Gettext(i,64,4))
ObjExcelAppl.Worksheets(1).Cells(lRow, 6).Value = Trim(autECLSession.autECLPS.Gettext(i,69,4))
ObjExcelAppl.Worksheets(1).Cells(lRow, 7).Value = Trim(autECLSession.autECLPS.Gettext(i,75,5))
''autECLSession.autECLOIA.WaitForAppAvailable
''autECLSession.autECLOIA.WaitForInputReady
''autECLSession.autECLPS.SendKeys "[roll up]"
''autECLSession.autECLOIA.WaitForAppAvailable
''autECLSession.autECLOIA.WaitForInputReady
Else
End if
Next
Next
''autECLSession.autECLOIA.WaitForAppAvailable
''autECLSession.autECLOIA.WaitForInputReady
ObjExcelAppl.ActiveWorkbook.Save
ObjExcelAppl.DisplayAlerts = True
end sub