msaccess vba to download table VBAP or VBAK

[Former Member]

Hi all, i'm a simple user, to imrove the office productivity i've write this vba on a MsAccess Db to download the selected table with RFC connection from Sap and write the data in Csv file (other macro import this file). After this i can use the data to send massive email to our customer with another my vba.
(I've already linked all references to Sap and Scripting in vb)

Sub sapConnection()
'
' This program connect to SAP R/3 RFC ABAP
'
'Declare the objects and variables
'
Dim functionCtrl As Object 'Function Control (Collective object)
Dim sapConnection As Object 'Connection object
Dim theFunc As Object 'Function object
'
'Create a function object
Set functionCtrl = CreateObject("SAP.Functions")
Set sapConnection = functionCtrl.Connection
'Logon with initial values
functionCtrl.LogFileName = "c:\tmp\SAPTABLEviewlog.txt"
functionCtrl.loglevel = 8
sapConnection.TraceLevel = 6
sapConnection.Client = "100"
sapConnection.User = "USERNAME" 'Replace it with the user needed for connection
sapConnection.language = "IT"
sapConnection.Password = "USER_PASSWORD"
sapConnection.System = "CHOOSE_SYTEM"
sapConnection.Destination = "CHOOSE_SYTEM"
sapConnection.Systemnumber = "00"
sapConnection.ApplicationServer = "SERVER_IP"
If sapConnection.Logon(0, False) <> True Then 'Try to connect
    ' If no connection available
    MsgBox "No connection to SAP R/3!"
    Exit Sub 'End program
Else
    ' Connection established
    MsgBox "Connected to SAP!"
    ' Interrogation's Variables
    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 = ";" 'Set the field separator for csv file
    QUERY_TABLE.Value = "VBAP" 'The choosen table to open
    
    ' Searh options
    'TOPTIONS.AppendRow
    'TOPTIONS(1, "TEXT") = "MAND EQ '000'" 'Filter
    'TFIELDS.AppendRow
    'TFIELDS(1, "FIELDNAME") = "VBELN" 'Doc
    'TFIELDS.AppendRow
    'TFIELDS(1, "FIELDNAME") = "POSNR" ' Position
    
    If RFC_READ_TABLE.Call = True Then
        If TDATA.RowCount > 0 Then 'if the table is not empty
            'Count rows
            MsgBox "Find " + Str$(TDATA.RowCount) + " rows. Start Import."
        End If
    Else
        MsgBox "Connection RFC failed"
    End If
    
    'Make csv file 
    Dim oFile As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oFile = fso.CreateTextFile("C:\zrefromsap.csv")
    NumRecord = TDATA.RowCount
    'oFile.WriteLine "Export from SAP with VBA" 'Add a line to the file manualy
    For intRow = 1 To NumRecord 'For all lines of table exec
        'Insert the row in the txt
        oFile.WriteLine TDATA(intRow, "WA")
        intRow = intRow + 1
    Next
    'Close the file txt
    oFile.Close
    Set fso = Nothing
    Set oFile = Nothing
    
    'Clos the SAP connection
    Set functionCtrl = Nothing
    Set sapConnection = Nothing
    
    MsgBox ("Export Finish!")
End If
End Sub

Then i've try some table but if i set QUERY_TABLE.Value to "VBAP" or "KNA1" (the 2 needed tables) The TDATA.RowCount return "0" but with 1 other table it function very well.

Can anyone explain me what's the matter? Thers a Trick?

Sorry for my terrible english.

[Stefan-Schnell]

Hello Luca,

as far as I can see is the size of a record from the tables VBAP and KNA1 greater than 512 characters. With RFC_READ_TABLE it is not possible to read a record which is larger than 512 characters. I think this could be the reason for your problem.

Unfortunetaly on my test system the tables VBAP and KNA1 doesn't exists. So I can't check the successful function of my HTA program. You find the HTA program in my Knowledge Collection here. Scroll down until "Access to SAP via ActiveX control", download the source as HTA file and execute it. Fill the form with your specific data and the table Name VBAP resp. KNA1 and press the button "Get data". Now you should see the content of the table. If it works you can look at the sub procedure GetData how I realize it and you can do it equally.

Otherwise try to reduce the fields of RFC_READ_TABLE with VBAP and KNA1 with the FIELDS table.

Let us know the results.

Cheers

Stefan

[Former Member]

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.