Hello,
I am testing using Excel VBA to connect to AS400 for simple getstring & putstring operations. I am able to pull data from AS400 but am not able to put data onto the active screen using either SendKeys or putstring commands. My code does not throw any errors and I am not able to figure out what is wrong. Any help is greatly appreciated. Thank you.
Sub AS400_Test2()</SPAN>
[PCOMM SCRIPT HEADER]</SPAN>
Language = VBSCRIPT</SPAN>
[PCOMM SCRIPT SOURCE]</SPAN>
' Initiate access to system</SPAN>
Dim SessObj As Object</SPAN>
Set SessObj = CreateObject("PCOMM.autECLSession")</SPAN>
' Initialize the session</SPAN>
SessObj.SetConnectionByName ("A")</SPAN>
Dim pcommPS, pcommOIA ' Get Handle to Current Emulator Session</SPAN>
'autECLSession.SetConnectionByName (ThisSessionName) ' Set Reference to Presentation Space area</SPAN>
Set pcommPS = SessObj.autECLPS</SPAN>
Set pcommOIA = SessObj.autECLOIA</SPAN>
' Find first data row of spreadsheet</SPAN>
Dim FirstRow As Integer 'Variable for first data row</SPAN>
Cells.Find(What:="ID", After:=ActiveCell, LookIn:=xlFormulas, _</SPAN>
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _</SPAN>
MatchCase:=False, SearchFormat:=False).Activate</SPAN>
FirstRow = ActiveCell.Offset(1, 0).row</SPAN>
Dim LastRow As Long 'Variable for last data row</SPAN>
Dim i As Integer 'Variable for loop counter</SPAN>
Dim intMax As Integer 'Variable for maximum value of loop</SPAN>
Dim strSignOn As String</SPAN>
Dim strPass As String</SPAN>
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row</SPAN>
intMax = LastRow</SPAN>
For i = FirstRow To LastRow</SPAN>
strSignOn = Range("A" & i).Value</SPAN>
strPass = Range("B" & i).Value</SPAN>
pcommOIA.WaitForInputReady</SPAN>
pcommPS.SendKeys "021", 24, 17</SPAN>
pcommOIA.WaitForInputReady</SPAN>
pcommPS.putstring strPass, 19, 53</SPAN>
pcommOIA.WaitForInputReady</SPAN>
pcommPS.SendKeys "[enter]"</SPAN>
Next i
' Unbind access to system
Set SessObj = Nothing
' Home worksheet
Range("A" & FirstRow).Select
MsgBox "Update is complete"
End Sub
</SPAN>
I am testing using Excel VBA to connect to AS400 for simple getstring & putstring operations. I am able to pull data from AS400 but am not able to put data onto the active screen using either SendKeys or putstring commands. My code does not throw any errors and I am not able to figure out what is wrong. Any help is greatly appreciated. Thank you.
Sub AS400_Test2()</SPAN>
[PCOMM SCRIPT HEADER]</SPAN>
Language = VBSCRIPT</SPAN>
[PCOMM SCRIPT SOURCE]</SPAN>
' Initiate access to system</SPAN>
Dim SessObj As Object</SPAN>
Set SessObj = CreateObject("PCOMM.autECLSession")</SPAN>
' Initialize the session</SPAN>
SessObj.SetConnectionByName ("A")</SPAN>
Dim pcommPS, pcommOIA ' Get Handle to Current Emulator Session</SPAN>
'autECLSession.SetConnectionByName (ThisSessionName) ' Set Reference to Presentation Space area</SPAN>
Set pcommPS = SessObj.autECLPS</SPAN>
Set pcommOIA = SessObj.autECLOIA</SPAN>
' Find first data row of spreadsheet</SPAN>
Dim FirstRow As Integer 'Variable for first data row</SPAN>
Cells.Find(What:="ID", After:=ActiveCell, LookIn:=xlFormulas, _</SPAN>
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _</SPAN>
MatchCase:=False, SearchFormat:=False).Activate</SPAN>
FirstRow = ActiveCell.Offset(1, 0).row</SPAN>
Dim LastRow As Long 'Variable for last data row</SPAN>
Dim i As Integer 'Variable for loop counter</SPAN>
Dim intMax As Integer 'Variable for maximum value of loop</SPAN>
Dim strSignOn As String</SPAN>
Dim strPass As String</SPAN>
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row</SPAN>
intMax = LastRow</SPAN>
For i = FirstRow To LastRow</SPAN>
strSignOn = Range("A" & i).Value</SPAN>
strPass = Range("B" & i).Value</SPAN>
pcommOIA.WaitForInputReady</SPAN>
pcommPS.SendKeys "021", 24, 17</SPAN>
pcommOIA.WaitForInputReady</SPAN>
pcommPS.putstring strPass, 19, 53</SPAN>
pcommOIA.WaitForInputReady</SPAN>
pcommPS.SendKeys "[enter]"</SPAN>
Next i
' Unbind access to system
Set SessObj = Nothing
' Home worksheet
Range("A" & FirstRow).Select
MsgBox "Update is complete"
End Sub
</SPAN>