Question

通过记录来自AS400的一些宏，然后通过.ebs文件添加一些代码，我能够在AS400中创建一个简单的命令。当我使用它时，它工作正常，但是当将其应用于10个用户时，通常会显示一条错误消息，“其他人正在'J：\ AS400 Automation \ tk.csv'中工作，请稍后重试。 “

下面是我编写的代码：

'----------------------------------------------------------------------
' This macro was created by the macro recorder.
' Macro File: \\yellowcorp.com\DFS\Global\AS400 Automation\TKFinder.ebs
' Date: Thu Sep 20 07:01:38 2018
' Recorded for profile: NewPenn 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("NewPenn 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

我不确定'Return'功能是否可以解决此错误，但是如果'Return'功能可以解决问题，我很谦虚地要求您提供有关此操作的专业知识。

提前谢谢！

-乔尼

多个用户通过AS400处理一个CSV文件

0 个答案: