Solved

PurchaseRequisition creation using VB application.

Posted on 2003-12-07
3
1,488 Views
Last Modified: 2013-12-08
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.
0
Comment
Question by:dim_442002
3 Comments
 
LVL 1

Accepted Solution

by:
pclarke1 earned 500 total points
ID: 10214244
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
                    .Rows.Add
                    .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"
                    Else
                        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
                    Loop
                   
   
                End With
               
            'Populate Account Information
               With oAccount
                    .Rows.Add
                    .Value(mvrindex, "PREQ_ITEM") = mvrindex
         
                    If mvAccAssCat = "K" Then
                        .Value(mvrindex, "COST_CTR") = Format(Sheet1.Range("B7").Value, "0000000000")
                    Else
                        .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
                        .Rows.Add
                     '   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
                        .Rows.Add
                        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
            Loop
   
    '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
                            .Rows.Add
                            OheadFlines(i + 1, 1) = "*"
                            OheadFlines(i + 1, 2) = Mid(SHeaderText, 1, 132)
                            SHeaderText = Mid(SHeaderText, 133, Len(SHeaderText))
                        End With
                    Next
                    oHeadtext.Call
                End If
               
            Else
   
                Range("F10").Value = oResult(1, 3)
               
            End If
   
        End If
       
    Else
         Call MsgBox(" Cannot logon ! ")
    End If
Else
    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

reqerrors:

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

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
       
        Columns("A").Select
        ROWMAX = Application.CountA(Selection) - 9
        ReDim MVDATAARRAY(ROWMAX, COLMAX + 2)
       
        Range(originpoint).Activate
       
        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
        Loop
        ActiveCell.Offset(1, -COLMAX - 2).Activate
        mvrowindex = mvrowindex + 1
 
    Loop
        Call CreateERPRequisition
        Application.ScreenUpdating = True
End Sub

***********************************ABAP PORTION*********
function y_npm_create_text.
*"----------------------------------------------------------------------
*"*"Local interface:
*"  IMPORTING
*"     VALUE(FID) LIKE  THEAD-TDID
*"     VALUE(FLANGUAGE) LIKE  THEAD-TDSPRAS
*"     VALUE(FNAME) LIKE  THEAD-TDNAME
*"     VALUE(FOBJECT) LIKE  THEAD-TDOBJECT
*"     VALUE(SAVE_DIRECT) TYPE  EXCOMMIT DEFAULT 'X'
*"     VALUE(FFORMAT) LIKE  TLINE-TDFORMAT DEFAULT '*'
*"  EXPORTING
*"     VALUE(RETURN) LIKE  BAPIRETURN STRUCTURE  BAPIRETURN
*"  TABLES
*"      FLINES STRUCTURE  TLINE
*"----------------------------------------------------------------------

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

endfunction.
0

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Salesforce reporting across objects 4 186
ERPNext 6 Email PDF all text is aligned on the left 6 182
What make java scalable ? 6 105
crm 2010 on premise 5 101
Hello All, In previous article we used Hortonworks sandbox to work with Hadoop. Now, lets think to create own single node Hadoop on Linux. Here we Install and Configure Apache Hadoop on UI based Oracle Linux. I assume, you have VMware installe…
I showed you how to use console view (HERE (http://www.experts-exchange.com/articles/18379/Getting-Started-and-Using-the-Salesforce-com-Console.html)) -– but how do you set it up on the admin side of Salesforce? Note that you have to have Admin leve…
In a recent question (https://www.experts-exchange.com/questions/29004105/Run-AutoHotkey-script-directly-from-Notepad.html) here at Experts Exchange, a member asked how to run an AutoHotkey script (.AHK) directly from Notepad++ (aka NPP). This video…
Exchange organizations may use the Journaling Agent of the Transport Service to archive messages going through Exchange. However, if the Transport Service is integrated with some email content management application (such as an antispam), the admini…

680 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question