VB and SAP connection with BAPI Active X control

[Former Member]

dear all,

can anybody send me the live example on VB and SAP connection with BAPI Active X control. i have integrated VB with SAP using RFC connector but i want to do the same with BAPI Active X control.

regards,

jigs

[messier31]

Hi Jigar,

Following is the code which will accept employee id as input and display his payroll result in excel sheet.. This will make use of <b>BAPI_WAGETYPE_EMPLOYEEGETLIST</b> for doing the needful data retrieval from SAP.

Hope this helps you

<b>----

---

</b>

<b>Sub CheckEmployee()</b>

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")

'Connect to R/3

Set sapConnection = functionCtrl.Connection

sapConnection.Client = "150"

sapConnection.user = "XXXX" 'You user id

sapConnection.Language = "EN"

sapConnection.password = "XXXXX" ' You password

If sapConnection.logon(0, False) <> True Then

MsgBox "No connection to R/3!"

Exit Sub 'End program

End If

Sheet1.Cells.Clear

Sheet1.Cells.Font.Name = "Times New Roman"

Sheet1.Cells.Font.Size = 11

'*********************** BAPI_WAGETYPE_EMPLOYEEGETLIST *********************

Dim returnFunc As Boolean

Dim returnParam As Object

Dim pernr As Long

Dim row, col As Integer

Dim retTab As Object

pernr = InputBox("Enter Employee Personnel Number")

Set theFunc = functionCtrl.Add("BAPI_WAGETYPE_EMPLOYEEGETLIST")

theFunc.exports("EMPLOYEENUMBER") = pernr

theFunc.exports("LANGUAGE") = "EN"

returnFunc = theFunc.call

'Cells(2, 1) = "Function Return Value"

'Cells(2, 2) = returnFunc

Set returnParam = theFunc.imports("RETURN")

Cells(1, 1) = "Personnel Number"

Cells(1, 2) = pernr

Cells(1, 2).Font.Bold = True

'Cells(3, 1) = "Message Ret Type"

'Cells(3, 2) = returnParam("TYPE")

Range(Cells(1, 1), Cells(3, 1)).BorderAround , xlThick, xlColorIndexAutomatic

Range(Cells(1, 2), Cells(3, 2)).BorderAround , xlThick, xlColorIndexAutomatic

Cells(4, 1).BorderAround , xlThick, xlColorIndexAutomatic

Cells(4, 2).BorderAround , xlThick, xlColorIndexAutomatic

Cells(4, 3).BorderAround , xlThick, xlColorIndexAutomatic

Cells(4, 4).BorderAround , xlThick, xlColorIndexAutomatic

Cells(4, 5).BorderAround , xlThick, xlColorIndexAutomatic

Range(Cells(1, 1), Cells(3, 1)).Font.Bold = True

Set retTab = theFunc.tables("WAGETYPES")

rw = 5

cl = 2

Cells(4, 1) = "WAGE LIST"

Cells(4, 1).Font.Bold = True

Cells(4, 2) = "Wage Type"

Cells(4, 3) = "Wage Text"

Cells(4, 4) = "Start Date"

Cells(4, 5) = "End Date"

For Each retTab In retTab.Rows

cl = 2

Cells(rw, cl) = retTab("WAGETYPE")

Cells(rw, cl + 1) = retTab("WAGELTEXT")

Cells(rw, cl + 2) = retTab("VALBEGIN")

Cells(rw, cl + 3) = retTab("VALBEGIN")

rw = rw + 1

Next

Range(Cells(5, 2), Cells(rw - 1, cl + 3)).BorderAround , xlThick, xlColorIndexAutomatic

'******************** BAPI_PERSDATA_GETDETAILEDLIST *********************

Set theFunc = Nothing

Set returnParam = Nothing

Set theFunc = functionCtrl.Add("BAPI_PERSDATA_GETDETAILEDLIST")

theFunc.exports("EMPLOYEENUMBER") = pernr

returnFunc = theFunc.call

Set returnParam = theFunc.imports("RETURN")

Dim dettab As Object

Set dettab = theFunc.tables("PERSONALDATA")

Cells(10, 1) = "EMPLOYEE DETAILS"

Cells(10, 2) = "First Name"

Cells(11, 2) = "Last Name"

Cells(12, 2) = "Gender"

Cells(13, 2) = "Date of Birth"

Cells(14, 2) = "Country of Birth"

Cells(15, 2) = "Marital Status"

Cells(16, 2) = "Nationality"

Cells(17, 2) = "SSN No."

Cells(10, 1).Font.Bold = True

Cells(10, 1).BorderAround , xlThick, xlColorIndexAutomatic

Range(Cells(10, 2), Cells(17, 2)).Font.Bold = True

Range(Cells(10, 2), Cells(17, 2)).BorderAround , xlThick, xlColorIndexAutomatic

Range(Cells(10, 3), Cells(17, 3)).BorderAround , xlThick, xlColorIndexAutomatic

For Each dettab In dettab.Rows

Cells(10, 3) = dettab("FIRSTNAME")

Cells(11, 3) = dettab("LASTNAME")

If dettab("GENDER") = 1 Then

Cells(12, 3) = "Male"

ElseIf dettab("GENDER") = 2 Then

Cells(12, 3) = "Female"

Else

Cells(12, 3) = "Others"

End If

Cells(13, 3) = dettab("DATEOFBIRTH")

Cells(14, 3) = dettab("COUNTRYOFBIRTH")

Cells(15, 3) = dettab("MARITALSTATUS")

Cells(16, 3) = dettab("NATIONALITY")

Cells(17, 3) = dettab("IDNUMBER")

Next

'****************** BAPI_GET_PAYROLL_RESULT_LIST ***************

Set theFunc = Nothing

Set returnParam = Nothing

Set theFunc = functionCtrl.Add("BAPI_GET_PAYROLL_RESULT_LIST")

theFunc.exports("EMPLOYEENUMBER") = pernr

returnFunc = theFunc.call

Set returnParam = theFunc.imports("RETURN")

Cells(19, 1) = "Directory of payroll results"

Cells(19, 1).Font.Bold = True

Cells(19, 1).BorderAround , xlThick, xlColorIndexAutomatic

Cells(20, 1) = "SEQNR "

Cells(20, 2) = "FPPERIOD"

Cells(20, 3) = "FPBEGIN"

Cells(20, 4) = "FPEND"

Cells(20, 5) = "BONUSDATE"

Cells(20, 6) = "PAYDATE"

Cells(20, 7) = "PAYTYPE_TEXT"

Range(Cells(20, 1), Cells(20, 7)).Font.Bold = True

Range(Cells(20, 1), Cells(20, 7)).BorderAround , xlThick, xlColorIndexAutomatic

Set retTab = theFunc.tables("RESULTS")

rw = 21

For Each retTab In retTab.Rows

cl = 1

Cells(rw, cl) = retTab("SEQUENCENUMBER")

Cells(rw, cl + 1) = retTab("FPPERIOD")

Cells(rw, cl + 2) = retTab("FPBEGIN")

Cells(rw, cl + 3) = retTab("FPEND")

Cells(rw, cl + 4) = retTab("BONUSDATE")

Cells(rw, cl + 5) = retTab("PAYDATE")

Cells(rw, cl + 6) = retTab("PAYTYPE_TEXT")

rw = rw + 1

Next

Range(Cells(20, 1), Cells(rw - 1, 1)).BorderAround , xlThick, xlColorIndexAutomatic

Range(Cells(20, 1), Cells(rw - 1, 2)).BorderAround , xlThick, xlColorIndexAutomatic

Range(Cells(20, 1), Cells(rw - 1, 3)).BorderAround , xlThick, xlColorIndexAutomatic

Range(Cells(20, 1), Cells(rw - 1, 4)).BorderAround , xlThick, xlColorIndexAutomatic

Range(Cells(20, 1), Cells(rw - 1, 5)).BorderAround , xlThick, xlColorIndexAutomatic

Range(Cells(20, 1), Cells(rw - 1, 6)).BorderAround , xlThick, xlColorIndexAutomatic

Range(Cells(20, 1), Cells(rw - 1, 7)).BorderAround , xlThick, xlColorIndexAutomatic

Range(Cells(20, 1), Cells(rw - 1, 7)).HorizontalAlignment = 3

'***************** LOGOFF ****************************************

functionCtrl.Connection.logoff

Set sapConnection = Nothing

Set functionCtrl = Nothing

End Sub

Enjoy SAP.

Pankaj Singh.

[Former Member]

Have a look at below link. It will surely help you.

http://help.sap.com/saphelp_46c/helpdata/en/76/4a42f7f16d11d1ad15080009b0fb56/content.htm

For more information on ActiveX control, have a look at below link.

http://help.sap.com/saphelp_46c/helpdata/en/59/ae4447488f11d189490000e829fbbd/content.htm

I hope it helps.

Best Regards,

Vibha

*Please mark all the helpful answers

[Former Member]

HI patel,

hope the follwing code wil help you .

*Copy the following code to general declarations section of the form.

Option Explicit

Dim con As Object

Dim bapictrl As Object

Dim Obj As Object

Dim Header As Object

Dim sreturn As Object

*Copy the following code to click event of the command Button (LOGIN)

Private Sub login_Click()

Set bapictrl = CreateObject("SAP.BAPI.1")

Set con = bapictrl.Connection

con.Client = "000"

con.User = "BCUSER"

con.password = "MINISAP"

con.Language = "EN"

If con.logon(0, False) <> True Then

MsgBox "No connection to R/3!"

Exit Sub 'End program

Else

MsgBox "connection to R/3 Successful!"

End If

End Sub

*Copy the following code to click event of the command Button (SAVE)

Private Sub save_Click()

Dim x As String

Set Obj = bapictrl.GetSAPObject("ZEMPLOYEE")

Set Header = bapictrl.DimAs(Obj, "ZBAPIEMP", "EMPDB")

Set sreturn = bapictrl.DimAs(Obj, "ZBAPIEMP", "Return")

Header.Value("code") = TextBox1.Text

Header.Value("name") = TextBox2.Text

Header.Value("salary") = TextBox3.Text

Obj.zbapiemp EMPDB:=Header, RETURN:=sreturn

x = sreturn.Value("message")

If x = "" Then

MsgBox "Created Successfully........"

Else

MsgBox x

End If

*Copy the following code to click event of the command Button (END)

End

End Sub

reward points if its help u.

rgds,

shan

[raguraman_c]

Hi,

Here's a challenge for you. I want to send PO details to vendor, remember by email. You need to achieve this from VB by reading BAPIs.

1. You need to read PO details.

2. You need to use Function Module to send mail, not the outlook or any other activex.

This is a real scenario, that i had faced. See if you can achieve this.

--Ragu

[Former Member]

Hello,

Your emails are bouncing back. Can you please let me know your correct id? I would like to get some information on similar issue.

Thanks,

Kiran