Re: msaccess vba to download table VBAP or VBAK

Thank you, the reason is the Buffer.

I've tryed your hta but it as the same problem. I changed my code to insert the error handling and it's true, it return "DATA BUFFER EXCEEDED"

After a web search i've found the workaround here: http://rfcconnector.com/documentation/kb/0007/ But i don't have developer privilegies then i've do this with the field.

This is my fully working code to automatically import to access Various Table (specified in Array) to get a fully ZRE Head information with only 20 seconds:

Sub sapConnection()
On Error GoTo ErrHandler ' In caso di errore vado alla apposita funzione

Dim functionCtrl As Object 'Function Control (Collective object)
Dim sapConnection As Object 'Connection object
Dim theFunc As Object 'Function object

Set functionCtrl = CreateObject("SAP.Functions")
Set sapConnection = functionCtrl.Connection

Kill ("c:\temp\SAPTABLEviewlog.txt")

functionCtrl.LogFileName = "c:\temp\SAPTABLEviewlog.txt"
functionCtrl.loglevel = 8
sapConnection.TraceLevel = 6
sapConnection.Client = "100"
sapConnection.User = "yourUserName" 'Replace it with the user needed for connection
sapConnection.language = "IT"
sapConnection.Password = "yourPasswordOfSapUser"
sapConnection.System = "CLP"
sapConnection.Destination = "CLP"
sapConnection.Systemnumber = "00"
sapConnection.ApplicationServer = "YourServerIPAddress"

If sapConnection.Logon(0, True) <> True Then
    MsgBox "No connection to SAP R/3!"
    Set functionCtrl = Nothing
    Set sapConnection = Nothing
    Exit Sub
Else
    MsgBox "Utente < " & sapConnection.User & " > Connesso Correttamente a SAP < " & sapConnection.Destination & " >."
    Dim AnnoCorrente, MeseCorrente, GiornoCorrente As Integer
    AnnoCorrente = DatePart("yyyy", Date)
    MeseCorrente = DatePart("m", Date)
    GiornoCorrente = DatePart("d", Date)
    Oggi = "" & AnnoCorrente & MeseCorrente & GiornoCorrente & ""
    Capodanno = "" & AnnoCorrente & "0101"
    Dim RFC_READ_TABLE, TOPTIONS, TDATA, TFIELDS, DELIMITER As Object
    Set RFC_READ_TABLE = functionCtrl.Add("RFC_READ_TABLE")
    Set QUERY_TABLE = RFC_READ_TABLE.exports("QUERY_TABLE")
    Set DELIMITER = RFC_READ_TABLE.exports("DELIMITER")
    Set TOPTIONS = RFC_READ_TABLE.Tables("OPTIONS")
    Set TDATA = RFC_READ_TABLE.Tables("DATA")
    Set TFIELDS = RFC_READ_TABLE.Tables("FIELDS")
   
    DELIMITER.Value = "," 'Imposto il separatore per i campi
    FieldRow = ""
   
    Dim TABELLE As Variant
    ' Possible Table: KNA1(lista clienti), VBAP(dettaglio ordini), VBAK(testate ordini), VBPA(Indirizzi Destinazioni), ADR6(Email clienti)
    TABELLE = VBA.Array("KNA1", "ADR6", "VBAK")
    For x = LBound(TABELLE) To UBound(TABELLE) 'define start and end of array
    QUERY_TABLE.Value = TABELLE(x)
   
    Tabella = TABELLE(x)
    Select Case Tabella
    Case "KNA1"
        TFIELDS.AppendRow
        TFIELDS(1, "FIELDNAME") = "KUNNR" ' CodCliente
        FieldRow = FieldRow & "KUNNR"
        TFIELDS.AppendRow
        TFIELDS(2, "FIELDNAME") = "NAME1" ' Nome 1
        FieldRow = FieldRow & "," & "NAME1"
        TFIELDS.AppendRow
        TFIELDS(3, "FIELDNAME") = "ORT01" ' Localita
        FieldRow = FieldRow & "," & "ORT01"
        TFIELDS.AppendRow
        TFIELDS(4, "FIELDNAME") = "PSTLZ" ' CAP
        FieldRow = FieldRow & "," & "PSTLZ"
        TFIELDS.AppendRow
        TFIELDS(5, "FIELDNAME") = "STRAS" ' Via e num civico
        FieldRow = FieldRow & "," & "STRAS"
        TFIELDS.AppendRow
        TFIELDS(6, "FIELDNAME") = "TELF1" ' Tel
        FieldRow = FieldRow & "," & "TELF1"
        TFIELDS.AppendRow
        TFIELDS(7, "FIELDNAME") = "TELFX" ' Fax
        FieldRow = FieldRow & "," & "TELFX"
        TFIELDS.AppendRow
        TFIELDS(8, "FIELDNAME") = "ADRNR" ' Indirizzo
        FieldRow = FieldRow & "," & "ADRNR"
        TFIELDS.AppendRow
        TFIELDS(9, "FIELDNAME") = "STCD1" ' Codice Fiscale
        FieldRow = FieldRow & "," & "STCD1"
        TFIELDS.AppendRow
        TFIELDS(10, "FIELDNAME") = "STCD2" ' P.Iva
        FieldRow = FieldRow & "," & "STCD2"
        TFIELDS.AppendRow
        TFIELDS(11, "FIELDNAME") = "KDKG3" ' Canale
        FieldRow = FieldRow & "," & "KDKG3"
        TFIELDS.AppendRow
        TFIELDS(12, "FIELDNAME") = "WERKS" ' Divisione
        FieldRow = FieldRow & "," & "WERKS"
        TFIELDS.AppendRow
        TFIELDS(13, "FIELDNAME") = "LOEVM" ' Flag Cancellazione
        FieldRow = FieldRow & "," & "LOEVM"
        TFIELDS.AppendRow
        TFIELDS(14, "FIELDNAME") = "LAND1" ' Nazione
        FieldRow = FieldRow & "," & "LAND1"

   Case "ADR6"
        TFIELDS.AppendRow
        TFIELDS(1, "FIELDNAME") = "CLIENT" ' Mandante
        FieldRow = FieldRow & "CLIENT"
        TFIELDS.AppendRow
        TFIELDS(2, "FIELDNAME") = "ADDRNUMBER" ' N.indirizzo
        FieldRow = FieldRow & "," & "ADDRNUMBER"
        TFIELDS.AppendRow
        TFIELDS(3, "FIELDNAME") = "SMTP_ADDR" ' Indirizzo email smtp
        FieldRow = FieldRow & "," & "SMTP_ADDR"

       
   Case "VBAP"
        TOPTIONS.AppendRow
        TOPTIONS(1, "TEXT") = "ERDAT BETWEEN '" & Capodanno & "' AND '" & Oggi & "' " 'Imposto le opzioni di filtraggio

        TFIELDS.AppendRow
        TFIELDS(1, "FIELDNAME") = "WERKS" ' Divisione
        FieldRow = FieldRow & "WERKS"
        TFIELDS.AppendRow
        TFIELDS(2, "FIELDNAME") = "ERDAT" ' Data Inserimento
        FieldRow = FieldRow & "," & "ERDAT"
        TFIELDS.AppendRow
        TFIELDS(3, "FIELDNAME") = "VBELN" ' Doc.Vendita
        FieldRow = FieldRow & "," & "VBELN"
        TFIELDS.AppendRow
        TFIELDS(4, "FIELDNAME") = "MATNR" ' Cod.Materiale
        FieldRow = FieldRow & "," & "MATNR"
        TFIELDS.AppendRow
        TFIELDS(5, "FIELDNAME") = "KDMAT" ' Cod.Materiale del Cliente
        FieldRow = FieldRow & "," & "KDMAT"
        TFIELDS.AppendRow
        TFIELDS(6, "FIELDNAME") = "EAN11" ' Codice EAN Barcode
        FieldRow = FieldRow & "," & "EAN11"
        TFIELDS.AppendRow
        TFIELDS(7, "FIELDNAME") = "SPART" ' Settore Merceologico
        FieldRow = FieldRow & "," & "SPART"
        TFIELDS.AppendRow
        TFIELDS(8, "FIELDNAME") = "KWMENG" ' Qta tot in unita di mis di vend
        FieldRow = FieldRow & "," & "KWMENG"
        TFIELDS.AppendRow
        TFIELDS(9, "FIELDNAME") = "VSTEL" ' Partita (V100-v300)
        FieldRow = FieldRow & "," & "VSTEL"

 

   Case "VBAK"
        TOPTIONS.AppendRow
        TOPTIONS(1, "TEXT") = "AUDAT BETWEEN '" & Capodanno & "' AND '" & Oggi & "' " 'Imposto le opzioni di filtraggio 1
        TOPTIONS.AppendRow
        TOPTIONS(2, "TEXT") = "AND AUART EQ 'ZRE' " 'Imposto le opzioni di filtraggio 2
        TOPTIONS.AppendRow
        TOPTIONS(3, "TEXT") = "AND AUGRU BETWEEN 'Z01' AND 'Z10'" 'Imposto le opzioni di filtraggio 3

        TFIELDS.AppendRow
        TFIELDS(1, "FIELDNAME") = "VBELN" ' Num Documento
        FieldRow = FieldRow & "VBELN"
        TFIELDS.AppendRow
        TFIELDS(2, "FIELDNAME") = "AUGRU" ' Ragione ordine es.Z01
        FieldRow = FieldRow & "," & "AUGRU"
        TFIELDS.AppendRow
        TFIELDS(3, "FIELDNAME") = "AUART" ' Tipo Ordine es.ZRE
        FieldRow = FieldRow & "," & "AUART"
        TFIELDS.AppendRow
        TFIELDS(4, "FIELDNAME") = "AUDAT" ' Data Ordine
        FieldRow = FieldRow & "," & "AUDAT"
        TFIELDS.AppendRow
        TFIELDS(5, "FIELDNAME") = "VKORG" ' Org.Commerciale es.V100
        FieldRow = FieldRow & "," & "VKORG"
        TFIELDS.AppendRow
        TFIELDS(6, "FIELDNAME") = "VKBUR" ' Uff.vendite
        FieldRow = FieldRow & "," & "VKBUR"
        TFIELDS.AppendRow
        TFIELDS(7, "FIELDNAME") = "KUNNR" ' Committente from KNA1
        FieldRow = FieldRow & "," & "KUNNR"
        TFIELDS.AppendRow
        TFIELDS(8, "FIELDNAME") = "BSTNK" ' Num.DDT
        FieldRow = FieldRow & "," & "BSTNK"
        TFIELDS.AppendRow
        TFIELDS(9, "FIELDNAME") = "BSTDK" ' Data DDT
        FieldRow = FieldRow & "," & "BSTDK"
        'TFIELDS.AppendRow
        'TFIELDS(10, "FIELDNAME") = "ERNAM" ' Creato da
        'FieldRow = FieldRow & "," & "ERNAM"

       
   Case "VBPA"
        TOPTIONS.AppendRow
        TOPTIONS(1, "TEXT") = "PARVW EQ 'WE'" 'Imposto le opzioni di filtraggio

        TFIELDS.AppendRow
        TFIELDS(1, "FIELDNAME") = "KUNNR" ' Codice cliente
        FieldRow = FieldRow & "KUNNR"
        TFIELDS.AppendRow
        TFIELDS(2, "FIELDNAME") = "ADRNR" ' Indirizzo
        FieldRow = FieldRow & "," & "ADRNR"
        TFIELDS.AppendRow
        TFIELDS(3, "FIELDNAME") = "ADRDA" ' Codice indirizzo
        FieldRow = FieldRow & "," & "ADRDA"
        TFIELDS.AppendRow
        TFIELDS(4, "FIELDNAME") = "STCEG" ' Partita IVA CEE
        FieldRow = FieldRow & "," & "STCEG"
    Case Else
        MsgBox ("Table not supported")
        Exit Sub
    End Select

    If RFC_READ_TABLE.Call = True Then
        If TDATA.RowCount > 0 Then
            FileCSV = "C:\zrefromsap_" & Tabella & ".csv"
            elimino = Dir(FileCSV)
            If Not elimino = "" Then
                MsgBox ("Delete old imports of " & Tabella & " .")
                Kill (FileCSV)
            Else
                MsgBox ("No old imports of " & Tabella & ", procedo.")
            End If
            'Conto le righe
            MsgBox "Found " + Str$(TDATA.RowCount) + " rows in Table " & Tabella & " . Start Importing in to MsAccess."

            Dim oFile As Object
            Set fso = CreateObject("Scripting.FileSystemObject")
            Set oFile = fso.CreateTextFile(FileCSV)
            NumRecord = TDATA.RowCount
            oFile.WriteLine FieldRow
            For intRow = 1 To NumRecord
                'Inserisco la riga nel file txt
                oFile.WriteLine TDATA(intRow, "WA")
                intRow = intRow + 1
            Next
           
            oFile.Close
            Set fso = Nothing
            Set oFile = Nothing

            If Dir(FileCSV) = "" Then
                MsgBox ("Export " & Tabella & "  Failed, Connection problem.")
            Else
                MsgBox ("Export " & Tabella & " Right!")
               
                Dim db As DAO.Database
                Set db = CurrentDb
                ProvvisoryTable = "" & Tabella & ""
                On Error Resume Next:   db.TableDefs.Delete "" & ProvvisoryTable & "":   On Error GoTo 0
                db.TableDefs.Refresh
               
                DoCmd.TransferText TransferType:=acImportDelim, TableName:="" & ProvvisoryTable & "", _
                    FileName:=FileCSV, HasFieldNames:=True
                db.TableDefs.Refresh
               
                db.Close:   Set db = Nothing

            End If

            Do Until TOPTIONS.RowCount = 0
                Call TOPTIONS.Rows.Remove(1)
            Loop
            Do Until TDATA.RowCount = 0
                Call TDATA.Rows.Remove(1)
            Loop
            Do Until TFIELDS.RowCount = 0
                Call TFIELDS.Rows.Remove(1)
            Loop
            FieldRow = ""
       
        Else
            MsgBox ("Connection RFC Ok, But no data in table " & Tabella & " .")
        End If
    Else
        MsgBox "Connection to " & Tabella & " trought RFC failed. Error: " & RFC_READ_TABLE.Exception
    End If
    Next x
   
    MsgBox ("Close SAP R/3 Connection!")
    sapConnection.Logoff
    Set functionCtrl = Nothing
    Set sapConnection = Nothing

End If
Exit Sub

ErrHandler:
    If Err.Number <> 0 Then
        Msg = "Error compiling VBA: " & Str(Err.Number) & " generated by: " _
                & Err.Source & Chr(13) & Err.Description
        MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
    End If

End Sub

You can view full relationship of the tables with a Query like this:

SELECT KNA1.KUNNR, KNA1.NAME1, KNA1.TELF1, KNA1.TELFX, ADR6.SMTP_ADDR, KNA1.STRAS, KNA1.ORT01, KNA1.PSTLZ, KNA1.STCD2, VBAK.AUDAT, VBAK.BSTNK, VBAK.VBELN

FROM (ADR6 RIGHT JOIN KNA1 ON ADR6.ADDRNUMBER = KNA1.ADRNR) RIGHT JOIN VBAK ON KNA1.KUNNR = VBAK.KUNNR;

Hoping this is useful for anyone in similar situation.
Hi all and tanks a lot for your help.

Luca

Message was edited by: Luca Piccinini Resolved problems.