Function ImpToSap(rfcName As String,inTabName As String,impStr As String,_
flagItem As NotesItem,retRtfItem As NotesRichTextItem)
'===================================================================
'
' 功能:用于调用输入输出均在Tables项中的SAP RFC
'
' 传入参数说明:
' rfcName RFC函数名
' inTabName RFC中用于输入的表名称
' impStr 需要传递给RFC输入表的数据字符串
' flagItem 用于存放每一条数据是否成功导入SAP的标志位,OK为成功,ERR为失败
' retRtfItem 存储用于最终显示给用户查看的SAP返回信息的RTF域名称
'
'===================================================================
Dim rfcApp As Variant
Dim inTable,outTable As Variant
Dim inRow As Variant
Dim rowStr,cellStr As Variant
Dim rowCount As Integer
Dim retMsg As String
Dim isErr As String
Dim mess1 As String
Dim flagList As Variant
On Error Goto hdl ‘报错跳转
Set rfcApp = Func.ADD("ZRFC_MM_015")
Set inTable = rfcApp.Tables("ITAB")
rowStr = Split(impStr, "^#") '拆分行
rowCount = Ubound(rowStr) '输入记录条数
For i = 0 To Ubound(rowStr)-1 '不输入最后一个空行
Set inRow = inTable.Rows.InsertRow 'RFC的输入Table插入新行
cellStr = Split(Cstr(rowStr(i)), "^*") '拆分列
inRow.value("SPCTR") = Trim(CStr(cellStr(0)))
inRow.value("LIFNR") = Trim(CStr(cellStr(1)))
inRow.value("MATNR") = Trim(CStr(cellStr(2)))
inRow.value("EKORG") = Trim(CStr(cellStr(3)))
inRow.value("WERKS") = Trim(CStr(cellStr(4)))
inRow.value("ESOKZ") = Trim(CStr(cellStr(5)))
Next
If rfcApp.Call Then
Msgbox "RFC函数"+rfcName+"调用成功,等待返回结果......"
'If outTable.Rows.Count<=0 Then
'retRtfItem.AppendText("未查到相关记录!请重新输入关键字!")
'Exit Function
'End If
Redim flagList(1 To rowCount+1) As String
Set outTable = rfcApp.Tables("ITAB")
isErr = "OK"
For j = 1 To rowCount
Set outRow = outTable.Rows(j)
retMsg = CStr(outRow.value("SFLAG")) '是否查询成功的标志
retMsg21 = CStr(outRow.value("ERMSG")) '是否查询成功的返回信息
retMsg1 = CStr(outRow.value("LIFNR")) '供应商编号
retMsg2 = CStr(outRow.value("MATNR")) '物料号
retMsg3 = CStr(outRow.value("MAKTX")) '物料描述
retMsg4 = CStr(outRow.value("LIFTX")) '供应商名称
retMsg5 = CStr(outRow.value("EKGRP")) '采购组
retMsg6 = CStr(outRow.value("OUNIT")) '订单单位
retMsg7 = CStr(outRow.value("KONWA")) '货币
retMsg8 = CStr(outRow.value("KPEIN")) '定价单位(每)
retMsg9 = CStr(outRow.value("KMEIN")) '定价单位
retMsg10 = CStr(outRow.value("KUMNE")) '价格单位:订单单位(价格单位的比值)
retMsg11 = CStr(outRow.value("KUMZA")) '价格单位:订单单位(订单单位的比值)
retMsg12=retMsg12+retMsg2+"^*"+Fulltrim(retMsg3)+"^*"+Fulltrim(retMsg6)+"^*"+Fulltrim(retMsg7)+"^*"+Fulltrim(retMsg8)+"^*"+Fulltrim(retMsg9)+"^*"+Fulltrim(retMsg10)+"^*"+Fulltrim(retMsg11)+"^#"
If retMsg = "Y" Then
flagList(j) = "OK"
doc.RtfSAPReturn100 = retMsg12
Else
isErr = "ERR"
flagList(j) = "ERR"
Call retRtfItem.AppendText("第 " + Cstr(j))
Call retRtfItem.AddTab(1)
Call retRtfItem.AppendText("条数据导入SAP失败!原因是:")
Call retRtfItem.AddNewline(1)
Call retRtfItem.AppendText(retMsg21)
Call retRtfItem.AddNewline(1)
End If
Next
flagItem.Values = flagList
If isErr = "OK" Then
Msgbox "全部成功导入SAP!"
'Call retRtfItem.AppendText("全部成功导入SAP!")
Else
Msgbox "存在导入SAP失败的情况!"
doc.RtfSAPReturn100="未查到相关记录!请重新输入关键字!"
End If
Msgbox "RFC函数"+rfcName+"调用执行完毕,结果已接收!"
Else
Msgbox "RFC函数"+rfcName+"调用失败!原因是:"+Cstr(rfcApp.message)
Call retRtfItem.AppendText("RFC函数"+rfcName+"调用失败!原因是:")
Call retRtfItem.AddNewline(1)
Call retRtfItem.AppendText(Cstr(rfcApp.message))
End If
Exit Function
