Macro showing error when used by Multiple Users

[Joni_Depp]

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."
    else
        msgbox xlRs.Fields.item(0).value
    end if
Else
    msgbox "Query not found."
End If


xlRs.Close
xlCon.Close


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 --------------------
GenericErrorHandler:
    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


ShipperCodeError:
    Msgbox "Shipper code is empty."
    Exit sub


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


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


End Sub

Can 'Return' function solve this issue? And if 'Return' function is the answer, I would like to ask for your expertise on how to do it.

Thank you in advance!

-Joni