SAP R/3 форум ABAP консультантов
Russian ABAP Developer's Club

Home - FAQ - Search - Memberlist - Usergroups - Profile - Log in to check your private messages - Register - Log in - English
Blogs - Weblogs News

VB codes (or VBA macro code) for access SAP, and run one RFC



 
Post new topic   Reply to topic    Russian ABAP Developer's Club Forum Index -> Connect to External system, Unix и Perl
View previous topic :: View next topic  
Author Message
admin
Администратор
Администратор



Joined: 01 Sep 2007
Posts: 1640

PostPosted: Sun Nov 04, 2007 7:46 pm    Post subject: VB codes (or VBA macro code) for access SAP, and run one RFC Reply with quote

I can give you some code, but not sure it will work for you. When you ( or the help desk ) installs the SAP GUI, you can also install the SAP RFC development kit, if you do this you will have in your c:\program files\SAP??? ( in my case C:\Program Files\SAP620 ) a folder with a .frm extension ( in my case "C:\Program Files\SAP620\SAPGUI\rfcsdk\ccsamp\RFCSamp.VB\RFCsamp.frm" )

From there you can start then, because you also need the vbp file and the vbw file in order to really make it work. If you just need the code, then here you go :

Code:
Option Explicit

Private Sub Command1_Click()
'Dim Foo As RFCSampObj ' Due to an acknowledged problem in MTS
Dim Foo As Object      ' we Dim Foo as Object instead of as RFCSampObj
Dim searchterm As String
Dim custlist As Recordset

Set Foo = CreateObject("RFCSampObj.RFCSampObj.1")
Foo.Destination = "IDES"
'Foo.Client     = "800"
'Foo.Language   = "E"
'Foo.UserID     = "test"
'Foo.Password   = "pw"

If Not Foo Is Nothing Then
    searchterm = Text1.Text
    'Unfortunately RFC_CUSTOMER_GET does not convert
    ' a SPACE selction into a * so we do it here....
    If IsEmpty(searchterm) Then searchterm = "*"
       
    On Error Resume Next
    Call Foo.GetCustList(searchterm, "", custlist)
   
    If Err.Number = 0 Then
        If Not custlist Is Nothing Then
            custlist.MoveFirst
            While Not custlist.EOF
                Debug.Print "------------------"
                Debug.Print "custlist.Fields(name1) " &
custlist.Fields("NAME1")
                Debug.Print "custlist.Fields(stras) " &
custlist.Fields("STRAS")
                Debug.Print "custlist.Fields(ort01) " &
custlist.Fields("ORT01")
                Debug.Print "custlist.Fields(pstlz) " &
custlist.Fields("PSTLZ")
                Debug.Print "custlist.Fields(telf1) " &
custlist.Fields("TELF1")
                Debug.Print "custlist.Fields(telfx) " &
custlist.Fields("TELFX")
                custlist.MoveNext
            Wend
        Else
           Debug.Print "ERROR: custlist is Nothing"
        End If
     Else
        Debug.Print "ERROR" & Err.Description
        MsgBox Err.Description, vbCritical, "Error:"
       
     End If
Else
    Debug.Print "Foo is nothing"
    MsgBox "Foo is nothing"
End If

End Sub

Private Sub Command2_Click()

'Dim Foo As RFCSampObj ' Due to an acknowledged problem in MTS
Dim Foo As Object      ' we Dim Foo as Object instead of as RFCSampObj

Dim rs As Recordset
Dim HeaderIn As Recordset
Dim ItemsIn As Recordset
Dim Partners As Recordset
Dim OrderNumber As String
Dim BapiReturn As Recordset
Dim SoldTo As Recordset
Dim ShipTo As Recordset
Dim Payer  As Recordset
Dim ItemsOut As Recordset

'Input tables can be crafted in two different ways:
' - either using the DimAsXXXX method which returns a fully
'   described but empty Recordset.
' - or using the AdvancedDataFactory to craft up a disconnected
'   Recordset.
' An example of the later is shown with the Partners Table
' the remaining input tables are crafted with the dim as.
Dim adf As Object
' Describe the shape of a disconnected recordset

Dim vrsShape(1)
Dim vrsParvw(3)
Dim vrsKunnr(3)

vrsParvw(0) = "PARTN_ROLE"
vrsParvw(1) = CInt(8)
vrsParvw(2) = CInt(2)
vrsParvw(3) = False

vrsKunnr(0) = "PARTN_NUMB"
vrsKunnr(1) = CInt(8)
vrsKunnr(2) = CInt(10)
vrsKunnr(3) = False

vrsShape(0) = vrsParvw
vrsShape(1) = vrsKunnr

' Create a disconnected recordset to pass as an input

Set adf = CreateObject("RDSServer.DataFactory")
If adf Is Nothing Then
    MsgBox "ADF == NOTGHING"
End If
Set Partners = adf.CreateRecordSet(vrsShape)

Set Foo = CreateObject("RFCSampObj.RFCSampObj.1")
If Not Foo Is Nothing Then

    ' Get an empty recordset which will be used as input in
CreateOrder call
   
    Call Foo.DimHeader(HeaderIn)
    HeaderIn.AddNew
    HeaderIn.Fields("DOC_TYPE") = "TA"
    HeaderIn.Fields("SALES_ORG") = "1000"
    HeaderIn.Fields("DISTR_CHAN") = "10"
    HeaderIn.Fields("DIVISION") = "00"
    HeaderIn.Fields("PURCH_NO") = "SM-1177-3"
    HeaderIn.Fields("INCOTERMS1") = "CPT"
    HeaderIn.Fields("INCOTERMS2") = "Hamburg"
    HeaderIn.Fields("PMNTTRMS") = "ZB01"
    HeaderIn.Update
   
    Call Foo.DimItems(ItemsIn)
    ItemsIn.AddNew
    ItemsIn.Fields("MATERIAL") = "R-1120"
    ItemsIn.Fields("PLANT") = "1200"
    ItemsIn.Fields("REQ_QTY") = 2000
    ItemsIn.Update
   
    Partners.AddNew
    Partners.Fields("PARTN_ROLE") = "AG"
    Partners.Fields("PARTN_NUMB") = "0000001177"
    Partners.Update
   
    'set logon information
    Foo.Destination = "IDES"
    'Foo.Client     = "800"
    'Foo.Language   = "E"
    'Foo.UserID     = "test"
    'Foo.Password   = "pw"
   
    Call Foo.OrderCreate(HeaderIn, _
                         ItemsIn, _
                         Partners, _
                         OrderNumber, _
                         SoldTo, _
                         ShipTo, _
                         Payer, _
                         ItemsOut, _
                         BapiReturn)
    Debug.Print "OrderNumber" & OrderNumber
    If BapiReturn Is Nothing Then
        MsgBox "BapiReturn is Nothing"
    Else
        BapiReturn.MoveFirst
        Debug.Print "BapiReturn.Type...." & BapiReturn.Fields("TYPE")
        Debug.Print "BapiReturn.Code...." & BapiReturn.Fields("CODE")
        Debug.Print "BapiReturn.Message." & BapiReturn.Fields
("MESSAGE")
        Debug.Print "BapiReturn.LogNo..." & BapiReturn.Fields
("LOG_NO")
        Debug.Print "BapiReturn.LogMsgNo" & BapiReturn.Fields
("LOG_MSG_NO")
    End If
Else
    MsgBox "Foo is nothing"
End If

End Sub


Private Sub Command3_Click()

'Dim Foo As RFCSampObj ' Due to an acknowledged problem in MTS
Dim Foo As Object      ' we Dim Foo as Object instead of as RFCSampObj

Dim SalesOrders As Recordset
Dim BapiReturn  As Recordset

Set Foo = CreateObject("RFCSampObj.RFCSampObj.1")

If Not Foo Is Nothing Then

    'set logon information
    Foo.Destination = "IDES"
    'Foo.Client     = "800"
    'Foo.Language   = "E"
    'Foo.UserID     = "test"
    'Foo.Password   = "pw"

       
    On Error Resume Next
    Call Foo.GetCustomerOrders(CustomerNumber.Text, _
              SalesOrg.Text, _
              , , , , _
              BapiReturn, _
              SalesOrders)
   
    If Err.Number = 0 Then
        If Not SalesOrders Is Nothing Then
            SalesOrders.MoveFirst
            While Not SalesOrders.EOF
                Debug.Print "------------------"
                Debug.Print "SalesOrders.Fields(SD_DOC).... " &
SalesOrders.Fields("SD_DOC")
                Debug.Print "SalesOrders.Fields(ITM_NUMBER) " &
SalesOrders.Fields("ITM_NUMBER")
                Debug.Print "SalesOrders.Fields(MATERIAL).. " &
SalesOrders.Fields("MATERIAL")
                Debug.Print "SalesOrders.Fields(REQ_QTY)... " &
SalesOrders.Fields("REQ_QTY")
                Debug.Print "SalesOrders.Fields(NAME)...... " &
SalesOrders.Fields("NAME")
                Debug.Print "SalesOrders.Fields(NET_VALUE). " &
SalesOrders.Fields("NET_VALUE")
                Debug.Print "SalesOrders.Fields(PURCH_NO).. " &
SalesOrders.Fields("PURCH_NO")
                SalesOrders.MoveNext
            Wend
        Else
           Debug.Print "ERROR: SalesOrders is Nothing"
        End If
        If BapiReturn Is Nothing Then
            MsgBox "BapiReturn is Nothing"
        Else
            BapiReturn.MoveFirst
            Debug.Print "BapiReturn.Type...." & BapiReturn.Fields
("TYPE")
            Debug.Print "BapiReturn.Code...." & BapiReturn.Fields
("CODE")
            Debug.Print "BapiReturn.Message." & BapiReturn.Fields
("MESSAGE")
            Debug.Print "BapiReturn.LogNo..." & BapiReturn.Fields
("LOG_NO")
            Debug.Print "BapiReturn.LogMsgNo" & BapiReturn.Fields
("LOG_MSG_NO")
        End If
     Else
        Debug.Print "ERROR"
        MsgBox Err.Description, vbCritical, "Error:"
       
     End If
Else
    MsgBox "Foo is nothing"
End If

End Sub
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    Russian ABAP Developer's Club Forum Index -> Connect to External system, Unix и Perl All times are GMT + 4 Hours
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
You cannot attach files in this forum
You can download files in this forum


All product names are trademarks of their respective companies. SAPNET.RU websites are in no way affiliated with SAP AG.
SAP, SAP R/3, R/3 software, mySAP, ABAP, BAPI, xApps, SAP NetWeaver and any other are registered trademarks of SAP AG.
Every effort is made to ensure content integrity. Use information on this site at your own risk.