当PR在SAP里面已不再使用时，可使用批量使用以下两个BAPI进行处理：
BAPI_REQUISITION_DELETE，进行删除处理, （速度快）
BAPI_PR_CHANGE，进行关闭，但不删除（速度较慢），需要加COMMIT
需要注意的是：如果PR信息不完整或有错误，BAPI无法对PR进行处理
Public Function DELPR()
Dim BAPI As Object, Exps As Object, MSGList As Object, PRList As Object
Dim rng, I As Integer, J As Integer
CHK01:
If SAPOn = False And I < 1 Then
LogOnSAP
I = I + 1
GoTo CHK01
ElseIf SAPOn = True Then
Set BAPI = SAP.Add("BAPI_REQUISITION_DELETE")
Set Exps = BAPI.Exports("NUMBER")
Set MSGList = BAPI.TABLES("RETURN")
Set PRList = BAPI.TABLES("REQUISITION_ITEMS_TO_DELETE")
‘PR列表，第10列X作删除标示，第二行PR号，第三行PR行号
Set rng = Sheet1.Range("A1:N5000")
For I = 2 To 192
If rng(I, 10) = "X" Then
Exps.Value = rng(I, 1)
PRList.AppendRow
PRList(1, 1) = rng(I, 2)
PRList(1, 2) = "X"
BAPI.call
'检查输出信息
'MsgBox MSGList(1, 3)
End If
Next
End If
End Function
’-------------------------------------------------------
‘BAPI_PR_CHANGE对PR进行关闭：
Public Function CHCPR()
Dim BAPI As Object, Exps As Object, MSGList As Object, PRList As Object
Dim ITM As Object, ITMX As Object, CMMT As Object
Dim rng, I As Integer, J As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
CHK01:
If SAPOn = False And I < 1 Then
LogOnSAP
I = I + 1
GoTo CHK01
ElseIf SAPOn = True Then
Set BAPI = SAP.Add("BAPI_PR_CHANGE")
Set CMMT = SAP.Add("BAPI_TRANSACTION_COMMIT")
Set Exps = BAPI.Exports("NUMBER")
Set ITM = BAPI.TABLES("PRITEM")
Set ITMX = BAPI.TABLES("PRITEMX")
Set MSGList = BAPI.TABLES("RETURN")
Set rng = Sheet1.Range("A1:N5000")
For I = 2 To 170
'PR列表，第10列X作删除标示，第二行PR号，第三行PR行号
If rng(I, 10) = "X" Then
Exps.Value = rng(I, 1)
ITM.Rows.RemoveAll
ITMX.Rows.RemoveAll
ITM.AppendRow
ITM(1, "PREQ_ITEM") = rng(I, 2) 'PUR_GROUP
'ITM(1, "PUR_GROUP") = "308"
'ITM(1, "PREQ_PRICE") = "0.01"
'ITM(1, "ITEM_CAT") = ""
ITM(1, "CLOSED") = "X" 'CLOSED ITEM_CAT/FIXED/PREQ_PRICE
ITMX.AppendRow
ITMX(1, "PREQ_ITEM") = rng(I, 2)
'ITMX(1, "PREQ_ITEMX") = "X"
'ITMX(1, "PUR_GROUP") = "X"
'ITMX(1, "PREQ_PRICE") = "X"
'ITMX(1, "ITEM_CAT") = "X"
ITMX(1, "CLOSED") = "X" 'CLOSED DELETE_IND
BAPI.Call
CMMT.Call
'检查输出信息
'MsgBox MSGList(1, 4)
End If
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End If
End Function