Макрос для получения данных из Iseries (AS400) с использованием Excel VBA - PullRequest
Новая
       20

Макрос для получения данных из Iseries (AS400) с использованием Excel VBA

0 голосов
/ 29 мая 2019

Я получаю данные из AS400 через надстройку Excel, и я пытаюсь найти автоматизированный, чтобы сделать это, потому что мне приходится делать это много раз с различными исходными файлами, и это раздражает необходимость постоянно входить в систему всякий раз, когда яиспользуйте новый исходный файл.

Например, для исходного файла "bond.tto" я бы сделал это для его загрузки:

В Excel перейдите к «Надстройкам» -> «Передача данных из iSeries.»Появляется окно «Запрос на передачу», и оттуда я выбираю «создать новый файл» ... путь и имя файла c: \ bond.tto.

«Положение начальной ячейки» Я выбрал столбецA и строку 1 и нажмите «включить заголовки столбцов».Я нажимаю «ОК».

, затем ввожу свои учетные данные, скажем, мое имя пользователя «abc», а pw - «abc».Сервер ... давайте назовем его «BLUE.TOR.MCFLY.COM.»

Может кто-нибудь предложить код для автоматизации этого?Пожалуйста и спасибо.

Устройство записи макросов не дает мне никаких строк кода для работы.Нет ошибок, так как макро-рекордер не работает.

Ответы [ 2 ]

0 голосов
/ 07 июня 2019

проверить это: 

 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
0 голосов
/ 29 мая 2019

В качестве примечания вы также можете использовать open JT400 в java, чтобы использовать DB2 SQL для запроса ваших таблиц.

Используя VBA, вы также можете использовать запросы следующим образом:

код, который я здесь использую, в основном из VBA New Database Connection .

Однако для вас важна строка подключения к вашей базе данных.При этом используется драйвер ODBC клиентского доступа для подключения к базе данных IBM i DB2 на сервере с именем POWER7 и другими параметрами.Я полагаю, что опция "translate" берет его из CSSID 65535 и преобразует его в нечто хорошее из 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
...