簡體   English   中英

使用vba的RFC多個表而不會丟失連接

[英]RFC Multiple tables with vba without losing connections

您好,我正在重構SAP Extraction的RFC代碼,並且遇到一些功能問題。 我之所以這樣做,是因為擁有大量可從SAP提取大量信息的工作表,我們需要更快,更容易理解的東西。

 Public ctlTableFactory, RFC_READ_TABLE, eQUERY_TAB, tblOptions, tblData, tblFields, funcControl, objConnection, ctlLogon, strExport1, strExport2
Public Sub conectasap()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    tempo_inicio = Now()

    Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set ctlLogon = CreateObject("SAP.LogonControl.1")
    Set funcControl = CreateObject("SAP.Functions")
    Set ctlTableFactory = CreateObject("SAP.TableFactory.1")
    Set objWindowsScriptShell = CreateObject("WScript.Shell")
    Set objConnection = ctlLogon.NewConnection

    objConnection.ApplicationServer = "XXXXXXXXXXXX"
    objConnection.SystemNumber = "XXXX"
    objConnection.Client = "XXX"
    objConnection.Language = "PT"
    objConnection.User = "XXXXXXXXXXXXX"
    objConnection.Password = "Cockpit1314"
    booReturn = objConnection.logon(0, True)

    If booReturn <> True Then

        MsgBox "Não foi possível conectar ao SAP. " + vbCrLf + vbCrLf + "1. Verifique sua conexão à internet" + vbCrLf + "2. Verifique a conexão do SAP" + vbCrLf + "3. Verifique se o computador possue o programa SAP" + vbCrLf + vbCrLf + "Caso persistir o problema, contacte o suporte.", vbOKOnly + vbInformation
        Stop
    End If

    funcControl.Connection = objConnection
    Set RFC_READ_TABLE = funcControl.Add("RFC_READ_TABLE")
    Set strExport1 = RFC_READ_TABLE.exports("QUERY_TABLE")
    Set strExport2 = RFC_READ_TABLE.exports("DELIMITER")
    Set tblOptions = RFC_READ_TABLE.Tables("OPTIONS")
    Set tblData = RFC_READ_TABLE.Tables("DATA")
    Set tblFields = RFC_READ_TABLE.Tables("FIELDS")

    Extrai_VBAK
    Extrai_VBAP
    'Extrai_VBEP RFC_READ_TABLE, strExport1, strExport2, tblOptions, tblData, tblFields
    'Extrai_MVKE RFC_READ_TABLE, strExport1, strExport2, tblOptions, tblData, tblFields

    objConnection = Nothing
    tempo_fim = Now() - tempo_inicio
    MsgBox tempo_fim

    'Call apply_formulas

    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

當我調用函數“ Extrai_VBAK”時,它可以正常工作,但是當轉到其他函數時,它根本不會從SAP下載任何內容。

功能碼:

    Function Extrai_VBAK()



    CREAT_DATE = Format(Now - 2, "YYYYMMDD")

    Sheets("VBAK").Select
    Range("A2:X200000").ClearContents

'//As funções abaixo são as conexões que o SAP precisa fazer para extrair as tabelas futuramente.
    strExport1.Value = "VBAK"
    strExport2.Value = ";"

'// VBELN = Numero do pedido
    tblFields.AppendRow
    tblFields(1, "FIELDNAME") = "VBELN"

'// AUART = Tipo do pedido
    tblFields.AppendRow
    tblFields(2, "FIELDNAME") = "AUART"

'// AUGRU = Motivo da ordem
    tblFields.AppendRow
    tblFields(3, "FIELDNAME") = "AUGRU"

'// KUNNR = Código do cliente
    tblFields.AppendRow
    tblFields(4, "FIELDNAME") = "KUNNR"

'// ERDAT = Data de criação
    tblFields.AppendRow
    tblFields(5, "FIELDNAME") = "ERDAT"

'// ERNAM = Nome da pessoa que criou
    tblFields.AppendRow
    tblFields(6, "FIELDNAME") = "ERNAM"

'// VDATU = Data de entrega
    tblFields.AppendRow
    tblFields(7, "FIELDNAME") = "VDATU"

'// KNUMV = Código da condição
    tblFields.AppendRow
    tblFields(8, "FIELDNAME") = "KNUMV"

'// LIFSK = Bloqueio de remessa
    tblFields.AppendRow
    tblFields(9, "FIELDNAME") = "LIFSK"

'// KVGR4 = Grupo do cliente / Distribuidor
    tblFields.AppendRow
    tblFields(10, "FIELDNAME") = "KVGR4"

'// KVGR5 = Grupo do cliente
    tblFields.AppendRow
    tblFields(11, "FIELDNAME") = "KVGR5"


'// Filtra para extrair apenas BR10
    tblOptions.AppendRow
    tblOptions(1, "TEXT") = "VKORG EQ 'BR10'"

'// Data de criação -2 dias
    tblOptions.AppendRow
    tblOptions(2, "TEXT") = "AND VDATU GE '" & CREAT_DATE & "' "

'// Elimina IC5067
    tblOptions.AppendRow
    tblOptions(3, "TEXT") = "AND KUNNR NE 'IC5067    ' "

    If RFC_READ_TABLE.call = True Then

        If tblData.RowCount > 0 Then

            For intRow = 1 To tblData.RowCount


                For coluna = 1 To 1

                    Cells(intRow + 1, coluna).Value2 = tblData(intRow, coluna)

                Next

            Next

        Else


        End If
    Else
        End

    End If



    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
    Range("A1").Select



    L = 2
    Do Until Cells(L, 1) = Empty
        Cells(L, 10).Value2 = Trim$(Cells(L, 10).Value2)

        L = L + 1
    Loop
    L = L - 1

End Function

您確定問題出在第一通電話和第二通電話之間的連接丟失了嗎? 在那種情況下,嘗試進行seconc調用時,我會收到諸如“連接斷開”的錯誤消息。 但是根據您的描述,沒有錯誤消息。 相反,第二個調用是“成功的”,但是不返回任何數據,對嗎?

也許您需要為每個調用創建一個新的RFC_READ_TABLE對象?

如果您激活RFC跟蹤(例如環境變量RFC_TRACE = 2)並查看第二個調用期間發送和接收的數據,我們可能還會看到更多信息。

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM