LOTUS调用RFC

xiaoxiao2021-02-28  33

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

转载请注明原文地址: https://www.6miu.com/read-2624597.html

最新回复(0)