×
The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.
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 ****************************************************/
' 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.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
jleleux@xxxxxxxxxxx
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact
[javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
midrange.com
