January 15, 2010

Excel to AS400 Script

Here is a great time saving macro for iSeries Client access sessions. If you use client access then you know manually updating records gives you a headache.

This script pulls records from an excel spreadsheet and imports them based on a recorded macro. Really simply solution and very effective.

First create your excel file with two headers "COL1" and "COL2" without the ""

Download the template and insert your macro. If your not familiar with macros - Start a client access sessions go to
Actions --> Start Recording Macro --> Give it a name and make sure to select VBScript File.

The macro saves to "C:\Program Files\IBM\Client Access\Emulator\Private\"

Thanks to Laurens Van Keer for the script: http://laurens.vankeer.eu/scripting/excel-2-as400-update + some slight adjustments from me.

[PCOMM SCRIPT HEADER]
LANGUAGE=VBSCRIPT
DESCRIPTION=
[PCOMM SCRIPT SOURCE]
OPTION EXPLICIT
autECLSession.SetConnectionByName(ThisSessionName)
Dim ObjExcelAppl, ObjWorkbook, ObjWorksheet, StrFileName
Dim cCol1, cCol2
Dim c1, c2

' ...
' Call the Main subroutine.
Main
' Clean up after executing your script.
Set ObjWorksheet = Nothing
Set ObjWorkbook = Nothing
Set ObjExcelAppl = Nothing

Sub Main()

    ' Open and create Excel spreadsheet.
    Set ObjExcelAppl = CreateObject("Excel.Application")
    StrFileName = ObjExcelAppl.GetOpenFilename _
        ("Microsoft Excel bestanden (*.xls*),*.xls*")
    ObjExcelAppl.DisplayAlerts = False

    ' Valid name?
    If StrFileName <> False then

        ' Open spreadsheet.
        Set ObjWorkbook = ObjExcelAppl.WorkBooks
        ObjWorkbook.Open StrFileName

    ' Check if spreadsheet is already open.
    On Error Resume Next
    ObjExcelAppl.ActiveWorkbook.Save
    If Err.Number = 1004 Then
        Msgbox "Excelfile is already open!"
        Exit Sub
    End If
    On Error GoTo 0

    ' Load first sheet in workbook.
    ObjExcelAppl.Worksheets(1).Activate
    Set ObjWorksheet = ObjExcelAppl.Worksheets(1)

        ' ...
        Process_Sheet
        ' ...
        ' Save and close workbook.
    ObjExcelAppl.ActiveWorkbook.Save
    ObjExcelAppl.DisplayAlerts = True
    ObjExcelAppl.ActiveWorkbook.Close(True)

    End If

End Sub

Function Process_Sheet()

    ' Correct sheet?
    Dim i
    If Is_Correct_Sheet() Then

        ' Process every row (except the header, i=1).
    i = 2

    ' Stop upon the first empty row we find.
    Do While ObjWorksheet.Cells(i, 2).Value <> Empty
        Process_Row(i)
        i = i + 1
        Loop

    Else
    Msgbox "Wrong Excel sheet!"
    End If

End Function

' Check if the given sheet is correct.
Function Is_Correct_Sheet()

    Dim c ' column number
    Is_Correct_Sheet = False
    c = 1

    Do While ObjWorksheet.Cells(1, c).Value <> ""

        Select case ObjWorksheet.Cells(1, c).Value
            case "COL1" cCol1 = c
            case "COL2" cCol2 = c
    End Select

        c = c + 1

    Loop

    ' Found header?
    If ( cCol1 <> 0 And cCol2 <> 0 ) Then
        Correct_Sheet = true
    End If

End Function

Function Process_Row(ByVal row)

    c1 = CStr(ObjWorksheet.Cells(row, cCol1).Value)
    c2 = CStr(ObjWorksheet.Cells(row, cCol2).Value)

    ' ... Insert your Recorded vbs Macro here
    ' Place cursor.
    autECLSession.autECLOIA.WaitForAppAvailable
    autECLSession.autECLPS.SetCursorPos 09,034

    ' Type c1 in current field (where cursor is positioned).
    autECLSession.autECLOIA.WaitForInputReady
    autECLSession.autECLPS.SendKeys c1
    autECLSession.autECLPS.SendKeys "[field+]"

    ' Type c2 in the next field.
    autECLSession.autECLOIA.WaitForInputReady
    autECLSession.autECLPS.SendKeys c2

    ' Send the data.
    autECLSession.autECLOIA.WaitForInputReady
    autECLSession.autECLPS.SendKeys "[enter]"
    autECLSession.autECLOIA.WaitForAppAvailable

    ' ...
End Function

' ...

(download)