Question

我正在通过Excel加载项从AS400中获取数据，并且我试图找到一种自动化的方法来执行此操作，因为我必须多次处理各种源文件，并且每次我不得不不断登录时，这很烦人使用新的源文件。

例如，对于源文件“ bond.tto”，我将执行以下操作来下载它：

在Excel中，转到“插件”->“从iSeries传输数据”。弹出“传输请求”窗口，然后从中选择“创建新文件”。路径和文件名为c：\ bond.tto。

“起始单元格位置”我选择了列A和第1行，然后单击“包括列标题”。我按“确定”。

然后输入我的凭据，假设我的用户名是“ abc”，而pw是“ abc”。服务器...我们称之为“ BLUE.TOR.MCFLY.COM”。

有人可以建议使用代码来自动化吗？请，谢谢。

宏记录器没有给我任何可使用的代码行。没有错误，因为宏记录器不起作用。

Answer 1

作为旁注，您还可以在java中使用开放式JT400来使用DB2 SQL查询表。

使用VBA，您还可以按以下方式使用查询：

我在这里使用的代码主要来自VBA New Database Connection。

但是，对您而言重要的是数据库连接字符串。这使用Client Access ODBC驱动程序以名称POWER7和其他选项连接到服务器上的IBM i DB2数据库。我相信“翻译”选项是从65535 CSSID中获取的，并将其转换为EBDIC中不错的东西。




Sub DbConnection()

    Dim cn As Object ' ADODB.Connection
    Set cn = CreateObject("ADODB.Connection") ' New ADODB.Connection
    Dim rs As Object ' ADODB.Recordset

    Dim strConn As String
    strConn = "DRIVER={Client Access ODBC Driver (32-bit)};" & _
                "Database=<myDataBase>;" & _
                "Hostname=<POWER7>;" & _
                "Port=1234;" & _
                "Protocol=TCPIP;" & _
                "Uid=<USERID>;" & _
                "Pwd=<PASSWORD>;" & _
                "SYSTEM=<POWER7>;" & _
                "DBQ=QGPL <YOUR BASE LIBRARY> <ANOTHER>;" & _
                "DFTPKGLIB=QGPL;" & _
                "LANGUAGEID=ENU;" & _
                "PKG=QGPL/DEFAULT(IBM),2,0,1,0,512;QRYSTGLMT=-1;" & _
                "TRANSLATE=1;" & _
                "CONNTYPE=2;" & _
                "REGIONAL=NO;"

    cn.Open strConn

    Dim queryArr, i
    queryArr = Array("SELECT * FROM <LIBRARY>.<TABLE>")

    For i = LBound(queryArr) To UBound(queryArr)
        ExecuteQuery queryArr(i), cn, rs
    Next i

    cn.Close
    Set cn = Nothing
End Sub

Private Sub ExecuteQuery(query As Variant, ByRef cn As Object, ByRef rs As Object)
    Set rs = CreateObject("ADODB.Recordset") ' New ADODB.Recordset
    With rs
        .ActiveConnection = cn
        .Open CStr(query)
        Sheets("Sheet1").Range("A1").CopyFromRecordset rs
        .Close
    End With
    Set rs = Nothing
End Sub

Answer 2

测试此：

 Option Explicit
    Option Base 1

    Sub Firmennamen()
    On Error GoTo ERRORHANDLER

    Dim sSQLFirmen As String
    Dim objListObj As ListObject
    Dim objListCols As ListColumns
    Set WB = ThisWorkbook
    Set ws_Einstellungen = WB.Worksheets("Einstellung") ' tab name in excel
    Set objListObj = ws_Einstellungen.ListObjects("FirmenNamen") ' table name in excel
    Set objListCols = objListObj.ListColumns

        ws_Einstellungen.Range("FirmenNamen").ClearContents ' clear table

        sconnect = "PROVIDER=IBMDA400;Data Source=server_name;USER ID=username;PASSWORD=Password;"
        conn.ConnectionTimeout = 30
        conn.Open sconnect
        Set mrs.ActiveConnection = conn
        sSQLFirmen = " SELECT t.col1 AS Nr, t.col2 AS Firma " & _
                    " From server_name.schema_name.table_name t " & _
                    " WHERE t.col2='010' " & _
                    " ORDER BY t.col1 "
        mrs.Open sSQLFirmen, conn
        For i = 0 To mrs.fields.count - 1
                    objListCols(i + 1).Name = mrs.fields(i).Name
                Next i
        ws_Einstellungen.Range("FirmenNamen").CopyFromRecordset mrs
        mrs.Close
        conn.Close
        Set mrs = Nothing
        Set conn = Nothing
        Exit Sub
         'get out before the Error Handler kicks in

        '//////////////////////////////////////////////////////////
        ERRORHANDLER:
            Call ERROR
        End

        End Sub





        Private Sub Workbook_Open()
            Call Firmennamen ' when excel open --> query update
        End Sub




        Sub ERROR()

            Select Case Err.Number
                Case -2147217843
                    msg = "Sie müssen Ihre User ID und Password eintragen: " & Err.Number _
                    & " oder Ihre user ID und Password sind nicht correct."
                    MsgBox msg, vbOKOnly
                Case 13
                    msg = "You have text data in a numeric field (" & BadField & "). Fix and re-Upload"
                    MsgBox msg, vbOKOnly
                Case 1004
                    msg = "Firma fehlt oder ist ungültig !"
                    MsgBox msg, vbOKOnly

                Case Else
                    msg = "DIe Fehler ist: " & Err.Number & " /  " & Err.Description & vbCrLf & vbCrLf & " Bitte sich bei IT melden (mit Screenshot dieser Meldung) !! :(  "
                    MsgBox msg, vbOKOnly
            End Select

            Err.Clear
            'Set GetConnection = Nothing

        End Sub

使用Excel VBA从Iseries（AS400）获取数据的宏

2 个答案: