Hi
I found in internet a program which I used in MS Access.
This program is making connection from Ms Access to SAP and downloading data from SAP table to Ms Access table.
But there is a problem with codepage.
When I logon to SAP and run function RFC_READ_TABLE I see there Polishletters like "ą", "ę", "ż"...
But when I use this MS Access program to download data form SAP to Ms Access, Polishletters arereplacedby "#"
This MS Access program is logon to SAP in language "PL"
Ms Access normaly see Polish leters (I can write Polish letteres directly to MS Access tabels).
Please helpsolve the problem.
I need to see Polish letters in MS Access table which have a data form SAP.
MS Access program:
Public Function RFC_READ_TABLE(tableName, columnNames, filter, table_name)
Dim R3 As Object, MyFunc As Object, App As Object
' Define the objects to hold IMPORT parameters
Dim QUERY_TABLE As Object
Dim DELIMITER As Object
Dim NO_DATA As Object
Dim ROWSKIPS As Object
Dim ROWCOUNT As Object
' Where clause
Dim OPTIONS As Object
' Fill with fields to return. After function call will hold
' detailed information about the columns of data (start position
' of each field, length, etc.
Dim FIELDS As Object
' Holds the data returned by the function
Dim DATA As Object
' Use to write out results
Dim ROW As Object
Dim Result As Boolean
Dim i As Long, j As Long, iRow As Long
Dim iColumn As Long, iStart As Long, iStartRow As Long, iField As Long, iLength As Long
Dim outArray, vArray, vField
Dim iLine As Long
Dim noOfElements As Long
'**********************************************
'Create Server object and Setup the connection
'use same credentials as SAP GUI DLogin
On Error GoTo abend:
Set R3 = CreateObject("SAP.Functions")
' Fill below logon details
R3.Connection.ApplicationServer = Forms!FORMULARZ1!Tekst7
R3.Connection.SystemNumber = Forms!FORMULARZ1!Tekst9
R3.Connection.System = Forms!FORMULARZ1!Tekst5
R3.Connection.Client = Forms!FORMULARZ1!Tekst13
R3.Connection.Password = Forms!FORMULARZ1!Tekst3
R3.Connection.User = Forms!FORMULARZ1!Tekst1
R3.Connection.Language = "PL"
If R3.Connection.Logon(0, True) <> True Then
RFC_READ_TABLE = "ERROR - Logon to SAP Failed"
MsgBox "No Connection to R/3!"
Exit Function
End If
'**********************************************
'*****************************************************
'Call RFC function RFC_READ_TABLE
'*****************************************************
Set MyFunc = R3.Add("BBP_RFC_READ_TABLE")
Set QUERY_TABLE = MyFunc.exports("QUERY_TABLE")
Set DELIMITER = MyFunc.exports("DELIMITER")
Set NO_DATA = MyFunc.exports("NO_DATA")
Set ROWSKIPS = MyFunc.exports("ROWSKIPS")
Set ROWCOUNT = MyFunc.exports("ROWCOUNT")
Set OPTIONS = MyFunc.tables("OPTIONS")
Set FIELDS = MyFunc.tables("FIELDS")
QUERY_TABLE.Value = tableName
DELIMITER.Value = ""
NO_DATA = ""
ROWSKIPS = "0"
ROWCOUNT = "0"
OPTIONS.Rows.Add
OPTIONS.Value(1, "TEXT") = filter ' where filter
vArray = Split(columnNames, ",") ' columns
j = 1
For Each vField In vArray
If vField <> "" Then
FIELDS.Rows.Add
FIELDS.Value(j, "FIELDNAME") = vField
j = j + 1
End If
Next
Result = MyFunc.Call
If Result = True Then
Set DATA = MyFunc.tables("DATA")
Set FIELDS = MyFunc.tables("FIELDS")
Set OPTIONS = MyFunc.tables("OPTIONS")
R3.Connection.LogOFF
Else
R3.Connection.LogOFF
' DLog "SAP RFC Error: " & MyFunc.EXCEPTION
Exit Function
End If
noOfElements = FIELDS.ROWCOUNT
iRow = 0
iColumn = 0
'ReDim outArray(0 To DATA.ROWCOUNT, 0 To noOfElements - 1)
'For Each ROW In FIELDS.Rows
' outArray(iRow, iColumn) = ROW("FIELDNAME")
' iColumn = iColumn + 1
'Next
'Display Contents of the table
'**************************************
iRow = 1
iColumn = 1
Dim l As String
Dim fipos
ReDim fipos(1 To FIELDS.ROWCOUNT, 1 To 3)
Dim db As DAO.Database
Set db = CurrentDb()
Dim sql As String
Dim r As String
On Error Resume Next
db.Execute "DROP TABLE " & table_name & ";"
If Err.Number <> 0 Then
' DLog "DROP TABLE Error: " & Err.Description
End If
On Error GoTo abend:
sql = "CREATE TABLE " & table_name & " ("
Dim sql_ins As String, sql_ins_l As String
'sql_ins = "INSERT INTO " & table_name & " ("
For iColumn = 1 To FIELDS.ROWCOUNT
fipos(iColumn, 1) = FIELDS(iColumn, "OFFSET") + 1
fipos(iColumn, 2) = CInt(FIELDS(iColumn, "LENGTH"))
fipos(iColumn, 3) = FIELDS(iColumn, "FIELDNAME")
If iColumn = FIELDS.ROWCOUNT Then
sql = sql & FIELDS(iColumn, "FIELDNAME") & " CHAR(" & fipos(iColumn, 2) & "));"
'sql_ins = sql_ins & FIELDS(iColumn, "FIELDNAME") & ") VALUES ("
Else
sql = sql & FIELDS(iColumn, "FIELDNAME") & " CHAR(" & fipos(iColumn, 2) & "), "
'sql_ins = sql_ins & FIELDS(iColumn, "FIELDNAME") & ", "
End If
Next
db.Execute sql
'DLog ("Saving " & DATA.ROWCOUNT & " records in local table " & table_name)
Dim rs As Recordset
Dim le As Long
Set rs = db.OpenRecordset(table_name, dbOpenTable, dbAppendOnly)
BeginTrans
For iLine = 1 To DATA.ROWCOUNT
l = DATA(iLine, "WA")
'sql_ins_l = sql_ins
le = Len(l)
rs.AddNew
For iColumn = 1 To FIELDS.ROWCOUNT
If fipos(iColumn, 1) > le Then
'outArray(iRow, iColumn - 1) = Null
'sql_ins_l = sql_ins_l & "NULL"
GoTo skipme:
Else
rs.FIELDS(fipos(iColumn, 3)) = Trim(Mid(l, fipos(iColumn, 1), fipos(iColumn, 2)))
'outArray(iRow, iColumn - 1) = Mid(l, fipos(iColumn, 1), fipos(iColumn, 2))
'sql_ins_l = sql_ins_l & "'" & Replace(Mid(l, fipos(iColumn, 1), fipos(iColumn, 2)), "'", "''") & "'"
End If
'If iColumn = FIELDS.ROWCOUNT Then
' sql_ins_l = sql_ins_l & ") "
'Else
' sql_ins_l = sql_ins_l & ", "
'End If
'rs.Update
Next
skipme:
rs.Update
'db.Execute sql_ins_l
Next
CommitTrans
RFC_READ_TABLE = outArray
Exit Function
abend:
RFC_READ_TABLE = Err.Description
End Function