Working Client Access VBS Macro

Since macros have popped up a couple of times recently I decided to see how easy it was, and how it compared to the Zephyr emulator. I have to say the Zephyr product is much easier!

Additionally, there were various issues to overcome, such as Excel enumeration in VBS and getting column names from the ISeries. But that's true regardless of the emulator if you are using VBS instead of VB6 / VB.NET.



Below is a working Client Access macro that has 2 macros - 1 will perform a MAPICS lookup and 2 will export of data to Excel - with column names.



Copy the below text (between the asterisks) and paste into notepad, save with a .mac extension to:
C:\Program Files\IBM\Client Access\Emulator\Private

Run it from Client Access. 

You need a DSN entry with translate CCSID 65535 set in order to run Macro 2 (export to Excel)


Have fun.....james


/**  copy starting below this line ****************************************************/

[PCOMM SCRIPT HEADER]
LANGUAGE=VBSCRIPT
DESCRIPTION=
[PCOMM SCRIPT SOURCE]
OPTION EXPLICIT
autECLSession.SetConnectionByName(ThisSessionName)

' Written 6/27/2011 James LeLeux - SPS Technologies - Adapt Freely!


' This line calls the master macro

Macro_Master


Sub Macro_Master()

Dim strPrompt

strPrompt = InputBox("Please enter 1 or 2 for macros, N to exit." + vbCrLf + "1 = Macro to perform MAPICS lookup," + vbCrLf + "2 = Macro to copy Physical File to Excel")
If strPrompt = "N" Or strPrompt = "n" Or strPrompt = "" Then
   Exit Sub
End If

If strPrompt = "1" Then
   Macro1
End If

If strPrompt = "2" Then
   Macro2
End If

End Sub



Sub Macro1()
'
' Macro1 Macro - Start MAPICS ,perform lookup - output to screen
'

Dim ItmNum, ItmDesc, JobNum
Dim strMXEnv, strUID, strPsswd
Dim strPrompt

MsgBox ("To run macro1 you must logged into ISeries command line")
strPrompt = InputBox("Enter 'Y' to continue," + vbCrLf + "or 'N' to have the macro log you into the ISeries")

If strPrompt = "" Then
   Exit Sub
End If

If strPrompt = "N" Or strPrompt = "n" Then
   strUID = InputBox("Please enter your ISeries User ID")
   strPsswd = InputBox("Please enter your ISeries User Password")

   autECLSession.autECLOIA.WaitForAppAvailable
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.SendKeys strUID
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.SendKeys "[tab]"
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.SendKeys strPsswd
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.SendKeys "[newline]"
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.SendKeys "[enter]"
   ' clear any login messages
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.SendKeys "[enter]"
End If


   strMXEnv = InputBox("Please enter your Mapics Environment: ie: 'XA'")

   autECLSession.autECLOIA.WaitForAppAvailable
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.SendKeys "mapics"
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.SendKeys "[enter]"
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.WaitForAttrib 5,20,"00","3c",3,10000

   autECLSession.autECLPS.WaitForCursor 5,21,10000

   autECLSession.autECLOIA.WaitForAppAvailable
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.SendKeys strMXEnv
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.SendKeys "[enter]"
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.WaitForAttrib 1,1,"30","3c",3,10000

   autECLSession.autECLPS.Wait 998 

   autECLSession.autECLOIA.WaitForAppAvailable
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.SendKeys "[enter]"
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.WaitForAttrib 20,5,"00","3c",3,10000

   autECLSession.autECLPS.WaitForCursor 20,6,10000

   autECLSession.autECLOIA.WaitForAppAvailable
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.SendKeys "im"
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.SendKeys "[enter]"
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.WaitForAttrib 20,5,"00","3c",3,10000

   autECLSession.autECLPS.WaitForCursor 20,6,10000

   autECLSession.autECLOIA.WaitForAppAvailable
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.SendKeys "1"
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.SendKeys "[enter]"
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.WaitForAttrib 20,5,"00","3c",3,10000

   autECLSession.autECLPS.WaitForCursor 20,6,10000

   autECLSession.autECLOIA.WaitForAppAvailable
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.SendKeys "5"
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.SendKeys "[enter]"
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.WaitForAttrib 3,6,"10","3c",3,10000

   autECLSession.autECLPS.WaitForCursor 3,7,10000

   itmnum = InputBox("Enter an Item Number to Look Up")


   autECLSession.autECLOIA.WaitForAppAvailable
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.SendKeys ItmNum
   autECLSession.autECLOIA.WaitForInputReady
   autECLSession.autECLPS.SendKeys "[enter]"
   autECLSession.autECLOIA.WaitForAppAvailable
   autECLSession.autECLOIA.WaitForInputReady

   autECLSession.autECLPS.Wait(100)
   ' Get info - screen scrape!
   ItmDesc = autECLSession.autECLPS.GetText(3,32,25)
   JobNum  = autECLSession.autECLPS.GetText(10,2,7)

   MsgBox ItmDesc + " from " + jobnum

   MsgBox "End of Macro1, now make it do what you want!"

end sub



Sub Macro2()
'
' Macro2 Macro - copy physical file to Excel
'

Dim objConn, objCmd, strSQL, strPrompt
Dim strDSN, strSystem, strUID, strPsswd
Dim strLib, strPFile
Dim objData, objXL

MsgBox ("To run this macro you must have a DSN entry with translate CCSID 65535 set")
strPrompt = InputBox("Enter 'Y' to continue," + vbCrLf + "or 'N' to exit and establish DSN")

If strPrompt = "N" Or strPrompt = "n" Or strPrompt = "" Then
   Exit Sub
End If


Set objXL = CreateObject("Excel.Application")
objXL.Workbooks.Add

strDSN = InputBox("Please enter your DSN name (must have translate CCSID 65535 set)")
strSystem = InputBox("Please enter your ISeries name or IP address")
strUID = InputBox("Please enter your ISeries User ID")
strPsswd = InputBox("Please enter your ISeries User Password")
strLib = InputBox("Please enter the Library where the physical file is stored")
strLib = UCase( strLib )
strPFile = InputBox("Please enter the name of the Physical File")
strPFile = UCase( strPFile )

Set objConn = CreateObject("ADODB.Connection")
objConn.Open "DSN=" &strDSN& ";Driver={Client Access ODBC Driver (32-bit)};" & "System=" & strSystem& ";" & "Uid=" &strUID&";" & "Pwd=" &strPsswd& ";"
' Create DSN and ensure your select to translate CCSID 65535
' & "BinAsChar=True;" & "ModeName=QPCSUPP;CCSID=37;PCCodePage=437"
Set objCmd = CreateObject("ADODB.Command")
objCmd.ActiveConnection = objConn



'Grab Column names
strSQL = "Select SYS_CNAME FROM QSYS2.SYSCOLUMNS WHERE TBNAME = '" &strPFile& "' AND DBNAME = '" &strLib& "'"
set objData = objConn.Execute(strSQL)

' Populate Excel with column titles from memory
objXL.Cells(1, 1).CopyFromRecordset objData

'show the spreadsheet
objXL.Visible = True

'Convert column of data to titles - TRANSPOSE
' xlTextValues publib enumerated value, use 2 (&H2)
objXL.Range("A:A").SpecialCells(2).Select
objXL.Selection.Copy
objXL.Range("B1").Select
' xlPasteAll publib enumerated value, use -4104 (&HFFFFEFF8)
' xlPasteSpecialOperationNone (or xlNone) publib enumerated value, use -4142
objXL.Selection.PasteSpecial -4104,-4142,False,True
objXL.Range("A:A").SpecialCells(2).Delete



' Grab Physical File Data
strSQL = "Select * from " &strLib& "." &strPFile
set objData = objConn.Execute(strSQL)

' Populate Excel with Physical File Data from memory
objXL.Cells(2, 1).CopyFromRecordset objData

' Close connection
objConn.close

' Release object
Set objXL   = Nothing
Set objData = Nothing
Set objCmd  = Nothing
Set objConn = Nothing

MsgBox "End of Macro2, now make it do what you want!"

End Sub

/*** copy to above this line *****************************************************************/


James LeLeux
IT Director: Cherry, Shur-Lok, & SPS Santa Ana
2701 South Harbor Blvd
Santa Ana, CA 92704
M   714-929-8063
SKYPE james.leleux
[email protected]


_______________________________________________
This is the MAPICS ERP System Discussion (MAPICS-L) mailing list
To post a message email: MAPICS-L-Zwy7GipZuJhWk0Htik3J/[email protected]
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/mapics-l
or email: MAPICS-L-request-Zwy7GipZuJhWk0Htik3J/[email protected]
Before posting, please take a moment to review the archives
at http://archive.midrange.com/mapics-l.