使用vba的RFC多个表而不会丢失连接

Question

Hello i'm refactoring a RFC code of SAP Extraction, and i'm getting a problem with some functions. I'm only doing this because with have a lot of worksheets that extract a bunch of information from SAP, we need something faster and easier to understand.

 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

When i call the function "Extrai_VBAK" it works perfectly, but when it goes to the other functions it simply does not download anything from SAP.

FUNCTION CODE:

    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

Answer 1

Are you sure the problem is that you lose the connection between the first and the second call? In that case I would expect an error message like "Connection broken", when trying to make the seconc call. But according to your descriptin there is no error message. Instead the second call is "successfull", but just doesn't return any data, is that right?

Perhaps you need to create a fresh RFC_READ_TABLE object for each call?

We might also see more, if you activate RFC trace (eg environment variable RFC_TRACE=2) and take a look at the data that is sent and received during the second call.