PurchaseRequisition creation using VB application.

Need help in creating of PR using VB application. I’m using in my Word Macros CreateFromData method and PurchaseRequisition BO proxy generated by DCOM CC. The problem is in SERVICES creation and AccountAssignment repetitive appropriation. I can populate code snippets if needed. Any assistance will be deeply appreciated.
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

This works for excel.

There is no way to create header text in a requisition via BAPI, we created a custom RFC for that (refer below for ABAP).

You also need to ensure that your users have the right Active X control on their machine.  wdtfuncs.ocx  The version I use with this is 549 kb in size.  The date on the file seems to be meaningless.

Option Explicit
Public ROWMAX, COLMAX, mvrowindex, mvcolindex As Integer
Public MVDATAARRAY() As String

'   define objects for BAPI Req
Dim oBAPICtrl, oLogonCtrl, oRequirementItems, oAccount, oResult, oReturn, boRequirement, oLineText As Object

'   define objects for headertext
Dim oHeadtext, SAPRFC, OheadFlines As Object

Declare Function GetActiveWindow Lib "user32" () As Long
Public ConnType As Boolean: Public ConnStatus As Boolean: Public TableStatus As Boolean

Function CreateERPRequisition() As Boolean

' This function creates a SAP requisition and populates the header text field from information contained in Sheet1 of this workbook.

'On Error GoTo reqerrors

Dim mvfield, mvAccAssCat, sReqObjectName, sMessage, SHeaderText As String
Dim textlines, retcol, mvindex, mvrindex, mvcindex, nNewStatus, i As Integer
textlines = 1
' Create SAP Connection Objects
    Set SAPRFC = CreateObject("SAP.Functions")
    Set oBAPICtrl = CreateObject("SAP.BAPI.1")
'   create R/3 logon control object
    Set oLogonCtrl = CreateObject("SAP.Logoncontrol.1")

'   connection object is part of the BAPI ActiveX Control object
    Set oBAPICtrl.Connection = oLogonCtrl.NewConnection

    ConnType = False       ' True establishes a silent connection

'Logon for Requisition BAPI

    If SAPRFC.Connection.Logon(GetActiveWindow(), ConnType) = True Then
        'Copy Logon Parameters to RFC connection
        oBAPICtrl.Connection.User = SAPRFC.Connection.User
        oBAPICtrl.Connection.Client = SAPRFC.Connection.Client
        oBAPICtrl.Connection.Password = SAPRFC.Connection.Password
        oBAPICtrl.Connection.ApplicationServer = SAPRFC.Connection.ApplicationServer
        oBAPICtrl.Connection.Language = SAPRFC.Connection.Language
        'logon to RFC Connection - Silent
        If oBAPICtrl.Connection.Logon(GetActiveWindow(), True) = True Then
        CreateERPRequisition = False
        sReqObjectName = "PurchaseRequisition"
        'Define Requisition Item Objects
        Set boRequirement = oBAPICtrl.getsapobject(sReqObjectName)
        Set oRequirementItems = oBAPICtrl.dimas(boRequirement, "CreateFromData", "RequisitionItems")
        Set oAccount = oBAPICtrl.dimas(boRequirement, "CreateFromData", "RequisitionAccountAs")
        Set oResult = oBAPICtrl.dimas(boRequirement, "CreateFromData", "Return")
        Set oLineText = oBAPICtrl.dimas(boRequirement, "CreateFromData", "RequisitionItemText")

        'Define Header RFC
        Set oHeadtext = SAPRFC.Add("Y_Npm_Create_Text")
        'Populate Requisition Item Detail
            mvrindex = 1
            Do Until mvrindex > ROWMAX
              With oRequirementItems
                    .Value(mvrindex, "Preq_Item") = mvrindex
                    .Value(mvrindex, "Doc_Type") = Sheet1.Range("b11").Value
                    .Value(mvrindex, "Preq_Name") = Sheet1.Range("B10").Value
                    If Range("b8").Value = "" Then
                        mvAccAssCat = "K"
                        mvAccAssCat = "F"
                    End If
                    .Value(mvrindex, "ACCTASSCAT") = mvAccAssCat
                    .Value(mvrindex, "Gr_Ind") = "X"
                    .Value(mvrindex, "Ir_Ind") = "X"
                    .Value(mvrindex, "PURCH_ORG") = "1000"
                    mvcindex = 1
                    Do Until mvcindex > COLMAX
                         .Value(mvrindex, MVDATAARRAY(0, mvcindex)) = MVDATAARRAY(mvrindex, mvcindex)
                         mvcindex = mvcindex + 1
                End With
            'Populate Account Information
               With oAccount
                    .Value(mvrindex, "PREQ_ITEM") = mvrindex
                    If mvAccAssCat = "K" Then
                        .Value(mvrindex, "COST_CTR") = Format(Sheet1.Range("B7").Value, "0000000000")
                        .Value(mvrindex, ("ORDER_NO")) = Format(Sheet1.Range("B8").Value, "0000000000")
                    End If
                    .Value(mvrindex, "CO_AREA") = "FL01"
                    .Value(mvrindex, "G_L_ACCT") = Format(Sheet1.Range("B9").Value, "0000000000")
               End With
            'Populate Item Text
               With oLineText
                    If MVDATAARRAY(mvrindex, COLMAX + 1) <> "" Then
                     '   Debug.Print "Stuff"
                        .Value(textlines, "PREQ_ITEM") = mvrindex
                        .Value(textlines, "TEXT_ID") = "B01"
                        .Value(textlines, "TEXT_FORM") = "/"
                        .Value(textlines, "TEXT_LINE") = MVDATAARRAY(mvrindex, COLMAX + 1) ' Will Only display 1st 133 characters
                        textlines = textlines + 1
                    End If
                    If MVDATAARRAY(mvrindex, COLMAX + 2) <> "" Then
                        Debug.Print "Stuff"
                        .Value(textlines, "PREQ_ITEM") = mvrindex
                        .Value(textlines, "TEXT_ID") = "B03"
                        .Value(textlines, "TEXT_FORM") = "/"
                        .Value(textlines, "TEXT_LINE") = MVDATAARRAY(mvrindex, COLMAX + 2) ' Will Only display 1st 133 characters
                        textlines = textlines + 1
                    End If
                End With
              mvrindex = mvrindex + 1
    'Make Call to create requisition
         CreateERPRequisition = boRequirement.CreateFromData(RequisitionItems:=oRequirementItems, RequisitionAccountAs:=oAccount, RequisitionItemText:=oLineText, return:=oResult)
        If CreateERPRequisition Then
            If CStr(boRequirement.Number) <> "" Then
                Range("f10").Value = CStr(boRequirement.Number)
                If Len(Sheet1.Range("B3").Value) > 0 Then
                    ' Populate Header Text
                    SHeaderText = Sheet1.Range("B3").Value
                    oHeadtext.Exports("Fid").Value = "B01"
                    oHeadtext.Exports("flanguage").Value = "E"
                    oHeadtext.Exports("fname").Value = boRequirement.Number
                    oHeadtext.Exports("fobject").Value = "EBANH"
                    Set OheadFlines = oHeadtext.Tables("flines")
                    For i = 0 To Len(SHeaderText) / 132
                        With OheadFlines
                            OheadFlines(i + 1, 1) = "*"
                            OheadFlines(i + 1, 2) = Mid(SHeaderText, 1, 132)
                            SHeaderText = Mid(SHeaderText, 133, Len(SHeaderText))
                        End With
                End If
                Range("F10").Value = oResult(1, 3)
            End If
        End If
         Call MsgBox(" Cannot logon ! ")
    End If
    Call MsgBox(" Cannot logon ! ")
End If

'clean up objects

Set oLineText = Nothing
Set oResult = Nothing
Set oReturn = Nothing
Set oAccount = Nothing
Set oRequirementItems = Nothing
Set boRequirement = Nothing
Set oLogonCtrl = Nothing
Set oBAPICtrl = Nothing
Set oHeadtext = Nothing
Set OheadFlines = Nothing
Set SAPRFC = Nothing

Exit Function


Sheet1.Range("f10").Value = Err.Description

End Function

Public Sub createdataarray()

' This sub creates an array of data that is used to populate the Requisition Item detail

        Application.ScreenUpdating = False
        Dim originpoint As String
        originpoint = "A14"
        COLMAX = 12
        ROWMAX = Application.CountA(Selection) - 9
        mvrowindex = 0
        mvcolindex = 1
        Do Until mvrowindex > ROWMAX
        mvcolindex = 1
        Do Until mvcolindex > COLMAX + 2
            MVDATAARRAY(mvrowindex, mvcolindex) = ActiveCell.Value
            Debug.Print mvrowindex, mvcolindex & "  " & ActiveCell.Value
            mvcolindex = mvcolindex + 1
            ActiveCell.Offset(0, 1).Activate
        ActiveCell.Offset(1, -COLMAX - 2).Activate
        mvrowindex = mvrowindex + 1
        Call CreateERPRequisition
        Application.ScreenUpdating = True
End Sub

***********************************ABAP PORTION*********
function y_npm_create_text.
*"*"Local interface:

  call function 'CREATE_TEXT'
            fid         = fid
            flanguage   = flanguage
            fname       = fname
            fobject     = fobject
            save_direct = save_direct
            fformat     = fformat
            flines      = flines
            no_init     = 1
            no_save     = 2
            others      = 3.
  if sy-subrc <> 0.
    call function 'BALW_BAPIRETURN_GET'
              type       = 'E'
              cl         = 'C0'
              number     = '563'
              bapireturn = return
              others     = 1.


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Enterprise Software

From novice to tech pro — start learning today.