Excel vba BAPI_CONTRACT_CREATE

dshtukin

При использовании код приведенного ниже, при наличии записи цена подаваемая на вход BAPI игнорируется. Каким образом можно ввести цену из файла?

Коллеги, Приветствую.

Имеется следующий макрос пол ученый путем редактирования работающего примера по созданию заказа на поставку:

Code:

Dim functionCtrl As Object
Dim sapConnection As Object
Dim theFunc As Object
Dim PoNumber

Public Sub Create_PO()


Set functionCtrl = CreateObject("SAP.Functions")
Set sapConnection = functionCtrl.Connection
sapConnection.Client = 100
sapConnection.Language = "RU"


If sapConnection.logon(0, False) <> True Then
    MsgBox "No connection to R/3 System"
    Exit Sub
End If


Set theFunc = functionCtrl.Add("BAPI_CONTRACT_CREATE")


Dim poheader As Object
Dim poitems As Object
Dim poitemschedule As Object
Dim retMess As Object
Dim returnFunc As Boolean
Dim startzeil As Integer
Dim endcol As Integer
Dim the_name As String

Set poheader = theFunc.exports.Item("HEADER")
Set poitems = theFunc.tables.Item("ITEM")
 

poheader.Value("VENDOR") = Range("D2")
poheader.Value("PURCH_ORG") = 1000
poheader.Value("COMP_CODE") = 9001
poheader.Value("PUR_GROUP") = "ПНФ"
poheader.Value("DOC_TYPE") = "WK"

For i = 2 To 999
If Range("A" & i) <> "" Then
poitems.Rows.Add
poitems.Value(i - 1, "MATERIAL") = Range("A" & i)
poitems.Value(i - 1, "PLANT") = "1000"
poitems.Value(i - 1, "NET_PRICE") = Range("B" & i)
poitems.Value(i - 1, "ITEM_NO") = i - 1
 
End If
Next i

returnFunc = theFunc.call

PoNumber = theFunc.imports("PURCHASINGDOCUMENT")
Set retMess = theFunc.tables.Item("RETURN")

MsgBox retMess.Value(1, "MESSAGE")

End Sub

В результате выполнения, ошибка:
Ни одной инстанции типа объекта PurchasingContract не создано. Внешняя ссылка: # 1

Korvax

В транзакции me31k есть еще обязательные поля для заполнения прт создании контракта. может необходимо еще заполнить:
VPER_START - Начало срока действия
VPER_END KDATE - Конец времени выполнения
ACUM_VALUE - Договорная стоимость области заголовка на кажд. распределен.
:?:

dshtukin

Добавил:

poheader.Value("VPER_START") = "20110101"
poheader.Value("VPER_END") = "20120101"
poheader.Value("ACUM_VALUE") = "99999999"

Результат тот же.

Korvax

А если руками попробовать через тр me31k с абсолютно такими же данными? он его создаст?

trop

можно попробовать получить минимальный рабочий тест в se37 для указанного ф/м и пробовать его

dshtukin

trop написал(а):

можно попробовать получить минимальный рабочий тест в se37 для указанного ф/м и пробовать его

Попробовал.
С помощью SE37 устранил еще несколько обязательных полей однако ошибка "Ни одной инстанции типа объекта PurchasingContract не создано. Внешняя ссылка: # 1" осталась.

Korvax

Через se37 все работает с этими же данными?

PS. В SE37 больше никаких ошибок не пишет?

dshtukin

Korvax написал:

Через se37 все работает с этими же данными?

PS. В SE37 больше никаких ошибок не пишет?

Пишет ошибку и предупреждение.

Вот вывод RETURN:

Code:

T ID                    NUM MESSAGE
E BAPI                 001 Ни одной инстанции типа объекта PurchasingContract не создано. Внешняя ссылка: # 1
W ME                   658 Определите также параметр интерфейса HEADERX

Besa

Не видно где Вы заполняете X-структуры/таблицы.(HEADERX/ITEMX)

dshtukin

Besa написал:

Не видно где Вы заполняете X-структуры/таблицы.(HEADERX/ITEMX)

HEADERX/ITEMX - заполнять не пришлось.

1) Сделал вручную ME31K по тем же данным, выявил еще 2 обязательных поля.
2) Снова прогнал SE37.
3) В итоге работающий макрос создающий контракт:

Code:

Dim functionCtrl As Object
Dim sapConnection As Object
Dim theFunc As Object
Dim theFunc_c As Object
Dim PoNumber

Public Sub Create_PO()


Set functionCtrl = CreateObject("SAP.Functions")
Set sapConnection = functionCtrl.Connection
sapConnection.Client = 100
sapConnection.Language = "RU"


If sapConnection.logon(0, False) <> True Then
    MsgBox "No connection to R/3 System"
    Exit Sub
End If


Set theFunc = functionCtrl.Add("BAPI_CONTRACT_CREATE")


Dim poheader As Object
Dim poitems As Object
Dim poitemschedule As Object
Dim retMess As Object
Dim returnFunc As Boolean
Dim startzeil As Integer
Dim endcol As Integer
Dim the_name As String

Set poheader = theFunc.exports.Item("HEADER")
Set poitems = theFunc.tables.Item("ITEM")

poheader.Value("VENDOR") = Range("D2")
poheader.Value("PURCH_ORG") = 1000
poheader.Value("COMP_CODE") = 9001
poheader.Value("PUR_GROUP") = "ÏÍÔ"
poheader.Value("DOC_TYPE") = "WK"
poheader.Value("CURRENCY") = "RUB"
poheader.Value("DOC_DATE") = Range("E2")
poheader.Value("VPER_START") = "01.01.2011"
poheader.Value("VPER_END") = "01.01.2013"
poheader.Value("ACUM_VALUE") = "999999999"


For i = 2 To 999
If Range("A" & i) <> "" Then
poitems.Rows.Add
poitems.Value(i - 1, "MATERIAL") = Range("A" & i)
'poitems.Value(i - 1, "PLANT") = "1000"
poitems.Value(i - 1, "NET_PRICE") = Range("B" & i)
poitems.Value(i - 1, "INFO_UPD") = "C"
poitems.Value(i - 1, "ITEM_NO") = i - 1
End If
Next i

returnFunc = theFunc.call

Set theFunc_c = functionCtrl.Add("BAPI_TRANSACTION_COMMIT")
returnFunc_ = theFunc_c.call


PoNumber = theFunc.imports("PURCHASINGDOCUMENT")
Set retMess = theFunc.tables.Item("RETURN")

MsgBox retMess.Value(1, "MESSAGE")

End Sub

Всем Спасибо!

Korvax

Code:

PoNumber = theFunc.imports("PURCHASINGDOCUMENT")
Set retMess = theFunc.tables.Item("RETURN")

MsgBox retMess.Value(1, "MESSAGE")

End Sub

может все таки стоит выводить все сообщения, а не только первое?

dshtukin

При использовании код приведенного ниже, при наличии записи цена подаваемая на вход BAPI игнорируется. Каким образом можно ввести цену из файла?

Korvax

Могу ошибаться, но попробуйте заполнить CALCTYPE в ITEM..

Правила форума

Excel vba BAPI_CONTRACT_CREATE

Кто сейчас на конференции