Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations IamaSherpa on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Looping in AS400

Status
Not open for further replies.
Dec 14, 2015
3
US
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


 
 http://files.engineering.com/getfile.aspx?folder=aaf13429-7082-4600-8cbe-177015c29b70&file=open_invoices.mac
And where is the COBOL code (you posted in the COBOL part of the forum)?


Nic
 
As Nic noted, this is a COBOL forum, not a AS400 forum. However, in your defense, I can't find a better place to ask the question.

==================================
adaptive uber info galaxies (bigger, better, faster, and more adept than cognitive innovative agile big data clouds)


 
really not the correct forum to post this as it is a vb question but..

Code:
for lrow = 2 to ObjExcelAppl.Worksheets(1).UsedRange.Rows.Count step 1
   for i = 7 to 22   --- variable i is not explicitly incremented so I assume default increment is 1

-- this code below for all 15/16 times per existing number of rows it is executed will always put the value returned by the function on the same cell as
     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))
   next
next

so lets assume following example
worksheet with 4 active rows

Code:
original values on spreadsheet
	A	B
1
2	2A_val	2B_val
3	3A_val	3B_val
4	4A_val	4B_val

input data (e.g. that returned by function autECLSession.autECLPS.Gettext()
assume only loop from 7 to 9
Code:
I	Value_22_10	Value_33_8
7	input_value_7_A	input_value_7_B	
8	input_value_8_A	input_value_8_B
9	input_value_9_A	input_value_9_B

Code:
(loop lrow = 2)
	loop( i = 7)
		cell	A2		B2
		value	input_value_7a	input_value_7b
	loop( i = 8)
		cell	A2		B2
		value	input_value_8a	input_value_8b
	loop( i = 9)
		cell	A2		B2
		value	input_value_9a	input_value_9b
      final value for row 2
		cell	A2		B2
		value	input_value_9a	input_value_9b
end lrow = 2

(loop lrow = 3)
	loop( i = 7)
		cell	A3		B3
		value	input_value_7a	input_value_7b
	loop( i = 8)
		cell	A3		B3
		value	input_value_8a	input_value_8b
	loop( i = 9)
		cell	A3		B3
		value	input_value_9a	input_value_9b
      final value for row 3
		cell	A3		B3
		value	input_value_9a	input_value_9b
end lrow = 3


(loop lrow = 4)
	loop( i = 7)
		cell	A4		B4
		value	input_value_7a	input_value_7b
	loop( i = 8)
		cell	A4		B4
		value	input_value_8a	input_value_8b
	loop( i = 9)
		cell	A4		B4
		value	input_value_9a	input_value_9b
      final value for row 4
		cell	A4		B4
		value	input_value_9a	input_value_9b
end lrow = 4


final values on worksheet after loops
	A	B
1
2	input_value_9a	input_value_9b
3	input_value_9a	input_value_9b
4	input_value_9a	input_value_9b


this was to visually explain what you are doing, which isn't what you wanted.

so in order to try sort you out can you please give us sample data (3 columns max and 5 rows max), sample spreadsheet layout before you open it, and desired output after you loop through your data.


Regards

Frederico Fonseca
SysSoft Integrated Ltd

FAQ219-2884
FAQ181-2886
 
Hello All,

I apologies for the confusion as i mentioned this is my first post and i have no idea where to to post this in this forum.

someone please suggest me the right forum to post this.

fredericofonseca - thank you for your reply.

i Have attached my excel file with screenshots in it.. please check code is same as i posted previously.

Thank you. hope you will help me.
 
 http://files.engineering.com/getfile.aspx?folder=c29981bf-419f-43c7-9119-4bfcfa46ab32&file=OPEN.xlsx
not quite what I asked but looking at your input this is what I think you are trying to do.

fyi the correct forum for this is forum707

Code:
[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 workrow

' this code is going to either add entries to a worksheet that already has data on it
' or is going to add entries to a blank one containing a header only at max
' not considering cases where this should update a worksheet with data on it and 
' where it should look to see if the entry being processed is already on the spreadsheet
' and should be updated instead of having an additional entry added

' if blank use following line
lRow = 2
' if append to existing worksheet use following line
' lRow = ObjExcelAppl.Worksheets(1).UsedRange.Rows.Count
[highlight #EF2929]'note that UsedRange has issues and should not be used. see [URL unfurl="true"]http://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-vba[/URL] for explanation[/highlight]

'set workrow to last row - this will be incremented for each row of data retrieved from the AS400

For i = 7 to 22
    if Trim(autECLSession.autECLPS.Gettext(i,75, 5)) = "OPEN" then
        workrow = workrow + 1
        ObjExcelAppl.Worksheets(1).Cells(workrow, 1).Value = Trim(autECLSession.autECLPS.Gettext(i,22,10))
        ObjExcelAppl.Worksheets(1).Cells(workrow, 2).Value = Trim(autECLSession.autECLPS.Gettext(i,33,8))
        ObjExcelAppl.Worksheets(1).Cells(workrow, 3).Value = Trim(autECLSession.autECLPS.Gettext(i,45,8))
        ObjExcelAppl.Worksheets(1).Cells(workrow, 4).Value = Trim(autECLSession.autECLPS.Gettext(i,56,7))
        ObjExcelAppl.Worksheets(1).Cells(workrow, 5).Value = Trim(autECLSession.autECLPS.Gettext(i,64,4))
        ObjExcelAppl.Worksheets(1).Cells(workrow, 6).Value = Trim(autECLSession.autECLPS.Gettext(i,69,4))
        ObjExcelAppl.Worksheets(1).Cells(workrow, 7).Value = Trim(autECLSession.autECLPS.Gettext(i,75,5))
    ' the following code is to scroll up a page
    ' taking this in consideration I am assuming that the intention of this
    ' macro is to copy several AS400 screens onto the same worksheet
        ''autECLSession.autECLOIA.WaitForAppAvailable
        ''autECLSession.autECLOIA.WaitForInputReady
        ''autECLSession.autECLPS.SendKeys "[roll up]"
        ''autECLSession.autECLOIA.WaitForAppAvailable
        ''autECLSession.autECLOIA.WaitForInputReady
    Else
    End if
Next
''autECLSession.autECLOIA.WaitForAppAvailable
''autECLSession.autECLOIA.WaitForInputReady
ObjExcelAppl.ActiveWorkbook.Save
ObjExcelAppl.DisplayAlerts = True

end sub

Regards

Frederico Fonseca
SysSoft Integrated Ltd

FAQ219-2884
FAQ181-2886
 
I seriously do not know how to explain my happiness.. after your suggestion its working like champ... am pulling entire history from as400 .. its gonna get huge appreciation for me...

even though i posted in wrong forum , i got my work done..

Frederico fonseca- you are genius... i would have bought a beer if you were in india now..thanks a lot man.. love you.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top