SQLTeam.com | Weblogs | Forums

How to share a csv file to multiple user at the same time in AS400


Hi Everyone!

I was able to create a simple command in AS400 by recording some macros from AS400 then adding some codes thru the .ebs file. It was working fine when I was using it but when it was applied to 10 users, it usually shows an error saying, "Someone else is working in 'J:\AS400 Automation\tk.csv' right now. Please try again later."

Below is the code that I have made:

' This macro was created by the macro recorder.
' Macro File: \\******\****\Global\AS400 Automation\TKFinder.ebs
' Date: Thu Sep 20 07:01:38 2018
' Recorded for profile: N***e*n AS400 S1

Function requestData(connStr As String, sqlStr As String)
' returns the result of the data.
' use isempty(requestData) to identify if the request has result or none

Dim xlCon As Object
Dim xlRs As Object
Dim rsData As Variant

Set xlCon = CreateObject("ADODB.Connection")
Set xlRs = CreateObject("ADODB.Recordset")

xlCon.Mode = 1 ' adModeRead / Indicates read-only permissions.
xlCon.Open connStr ' open the csv database

xlRs.LockType = 1 ' adLockReadOnly / Indicates read-only records. You cannot alter the data.xlRs.Open sqlStr, xlCon ' send query
xlRs.Open sqlStr, xlCon

If Not xlRs.EOF Then
    ' execute only if there is record found in the query
    if isnull(xlRs.Fields.item(0).value) then
        msgbox "No requirement."
        msgbox xlRs.Fields.item(0).value
    end if
    msgbox "Query not found."
End If


Set xlRs = Nothing
Set xlCon = Nothing

End Function

Sub Main
Dim HostExplorer as Object
Dim MyHost as Object
Dim Rc as Integer

On Error goto GenericErrorHandler

Set HostExplorer = CreateObject("HostExplorer") ' Initialize HostExplorer Object
Set MyHost = HostExplorer.HostFromProfile("N***e*n AS400 S1") ' Set object for the desired session
If MyHost is Nothing Then Goto NoSession

    If Not MyHost.Area(6,2,6,3).Value="SC" Then Exit Sub

    On Error goto ShipperCodeError
    Dim shipperCode As long
    shipperCode = MyHost.Area(6,5,6,11).Value
    shipperCode = trim(shipperCode)

    Dim dbName As String, connStr As String, sqlStr As String
    Dim leadData

    dbpath = "J:\global\AS400 Automation"
    connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath & ";Extended Properties=""text;HDR=Yes;FMT=Delimited;"""

    if isempty(shippercode) then exit sub

    dbName = "tk.csv"
    sqlStr = "SELECT Requirement " & _
            "FROM [" & dbName & "] Where [Shipper Code] = " & shipperCode & ";"

    requestData connStr, sqlStr

Exit Sub

'-------------------- Runtime Error Handlers --------------------
    Msgbox "Error " & Err & " : """ & Error(Err) & """ has occurred on line " & Erl-1 & "." & Chr(10) & "Unable to continue macro execution.", 16, "HostExplorer Basic Macro Error"
    Exit Sub

    Msgbox "Shipper code is empty."
    Exit sub

    Msgbox "Profile ""NewPenn AS400 S1"" is not running." & Chr(10) & "Unable to execute macro.", 16, "HostExplorer Macro Error"
    Exit Sub

    Msgbox "Unable to type string on host screen." & Chr(10) & "Unable to continue macro execution.", 16, "HostExplorer Basic Macro Error"
    Exit Sub

End Sub

The macro was assigned to a keyboard command in AS400 and it's working fine when I was testing it, however; when it was shared to other users, the error started to chow up. It seems that if the file is currently being worked on by another user, the others cannot access the file.

Is it possible to fix this issue and how? I would really like to know how to fix this as it will benefit everyone from our team.