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
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.
Thanks!