以下代码也只是试验品，仅供参考，但是经过实验是可以下载文件的。
SAP FM：ZDOWNLOAD_DOC_FROM_OUTSIDE（RFC）
该函数作用是可以得到文档附件对应的16进制
FUNCTION ZDOWNLOAD_DOC_FROM_OUTSIDE.
*"----------------------------------------------------------------------
*"*"Local interface:
*" IMPORTING
*" VALUE(IM_DOKAR) TYPE DRAW-DOKAR
*" VALUE(IM_DOKNR) TYPE DRAW-DOKNR
*" VALUE(IM_DOKVR) TYPE DRAW-DOKVR
*" VALUE(IM_DOKTL) TYPE DRAW-DOKTL
*" VALUE(ORIGINALPATH) TYPE FILEP DEFAULT 'C:\'
*" EXPORTING
*" VALUE(SIZE) TYPE INT4
*" VALUE(MIMETYPE) TYPE W3CONTTYPE
*" TABLES
*" DATA_TAB STRUCTURE SDOKCNTBIN
*"----------------------------------------------------------------------
DATA:LT_FILES TYPE BAPI_DOC_FILES2 OCCURS 0 WITH HEADER LINE.
DATA:LT_INFO TYPE SCMS_ACINF OCCURS 0 WITH HEADER LINE.
CALL FUNCTION 'BAPI_DOCUMENT_GETDETAIL2'
EXPORTING
DOCUMENTTYPE = IM_DOKAR
DOCUMENTNUMBER = IM_DOKNR
DOCUMENTPART = IM_DOKTL
DOCUMENTVERSION = IM_DOKVR
GETACTIVEFILES = 'X'
GETDOCFILES = 'X'
TABLES
DOCUMENTFILES = LT_FILES.
IF SY-SUBRC = 0.
READ TABLE LT_FILES INDEX 1.
IF SY-SUBRC = 0.
CALL FUNCTION 'SCMS_DOC_READ'
EXPORTING
STOR_CAT = LT_FILES-STORAGECATEGORY
DOC_ID = LT_FILES-FILE_ID
TABLES
ACCESS_INFO = LT_INFO
CONTENT_BIN = DATA_TAB.
READ TABLE LT_INFO INDEX 1.
IF SY-SUBRC = 0.
SIZE = LT_INFO-COMP_SIZE.
MIMETYPE = LT_INFO-MIMETYPE.
ENDIF.
ENDIF.
ENDIF.
ENDFUNCTION.
VB部分：
Option Explicit
Dim oDoc As DOMDocument
Dim DOCINPATH As String
Dim XMLOUTPATH As String
Dim DOCOUTPATH As String
Private arry() As Byte
Private Declare Function RfcAllowStartProgram Lib "librfc32" (ByVal RAccess As String) As Integer
Private Sub Command1_Click()
Dim RETURNCODE As Integer
RETURNCODE = RfcAllowStartProgram("sapftp;saphttp")
download
End Sub
Private Sub download()
Dim R3 As Object
Dim Sap As Object
Dim MyFunc As Object
Dim table As Object
Dim buffer As String
Dim size As Long
Dim mimetype As String
Dim i As Long
Dim count As Long
Set R3 = CreateObject("SAP.Functions")
Set Sap = R3.Connection
Sap.ApplicationServer = "***"
Sap.Client = "***"
Sap.User = "***"
Sap.Password = "***"
Sap.Language = "ZH"
If Sap.Logon(0, True) = True Then
Set MyFunc = R3.Add("ZDOWNLOAD_DOC_FROM_OUTSIDE")
MyFunc.exports("IM_DOKAR") = "ST4"
MyFunc.exports("IM_DOKNR") = "TCD00000001366"
MyFunc.exports("IM_DOKTL") = "000"
MyFunc.exports("IM_DOKVR") = "-"
MyFunc.exports("ORIGINALPATH") = "C:\"
If MyFunc.Call = True Then
Set table = MyFunc.Tables("data_tab")
size = MyFunc.imports("size")
mimetype = MyFunc.imports("mimetype")
buffer = ""
count = 2044 - (table.rowcount * 2044 - size * 2)
For i = 1 To table.rowcount
If i < table.rowcount Then
buffer = buffer & table(i, "line")
Else
buffer = buffer & Left(table(i, "line"), count)
End If
Next
arry = buffer
''通过XML方式转化16进制并生成文件
Call cmdCreateXML_Click
Call cmdGetBinary_Click
Else
MsgBox "调用RFC出错,请联系作者!"
Unload Me
End If
Else
MsgBox "登陆到SAP失败!"
End If
Sap.Logoff
Set table = Nothing
Set MyFunc = Nothing
Set R3 = Nothing
Set Sap = Nothing
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' How to create XML with binary data
'
' General program flows:
'
' Build builds a small XML file from a MS Doc file
' Write saves XML tree to a file
' Write the MS Doc file as another file
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Use the version dependent progid DOMDocument40 to create an MSXML 4.0 DOMDocument object if your are referencing MSXML 4.0 in your project.
Private Sub cmdCreateXML_Click()
Dim oEle As IXMLDOMElement
Dim oRoot As IXMLDOMElement
Dim oNode As IXMLDOMNode
DOCINPATH = App.Path & "\DocInput.doc"
XMLOUTPATH = App.Path & "\XmlOuput.xml"
Call ReleaseObjects
Set oDoc = New DOMDocument
oDoc.resolveExternals = True
' Create processing instruction and document root
Set oNode = oDoc.createProcessingInstruction("xml", "version='1.0'")
Set oNode = oDoc.insertBefore(oNode, oDoc.childNodes.Item(0))
' Create document root
Set oRoot = oDoc.createElement("Root")
Set oDoc.documentElement = oRoot
oRoot.setAttribute "xmlns:dt", "urn:schemas-microsoft-com:datatypes"
Set oNode = oDoc.createElement("Data")
oRoot.appendChild oNode
Set oEle = oNode
' Use DataType so MSXML will validate the data type
oEle.dataType = "bin.hex"
' Read in the data
oEle.Text = arry
oDoc.Save XMLOUTPATH
End Sub
Function ReadBinData(ByVal strFileName As String) As Variant
Dim lLen As Long
Dim ifile As Integer
Dim arrBytes() As Byte
Dim lCount As Long
Dim strOut As String
'Read from disk
ifile = FreeFile()
Open strFileName For Binary Access Read As ifile
lLen = FileLen(strFileName)
ReDim arrBytes(lLen - 1)
Get ifile, , arrBytes
Close ifile
ReadBinData = arrBytes
End Function
Private Sub WriteBinData(ByVal strFileName As String)
Dim ifile As Integer
Dim arrBuffer() As Byte
Dim oNode As IXMLDOMNode
If Not (oDoc Is Nothing) Then
' Get the data
Set oNode = oDoc.documentElement.selectSingleNode("/Root/Data")
' Make sure you use a byte array instead of variant
arrBuffer = oNode.nodeTypedValue
' Write to disk
ifile = FreeFile()
Open strFileName For Binary Access Write As ifile
Put ifile, , arrBuffer
Close ifile
End If
End Sub
Private Sub cmdGetBinary_Click()
DOCOUTPATH = App.Path & "\DocOutput.doc"
Set oDoc = New DOMDocument
If oDoc.Load(XMLOUTPATH) = True Then
' Save the Doc as another file
WriteBinData DOCOUTPATH
MsgBox DOCOUTPATH & " is created for you."
Else
MsgBox oDoc.parseError.reason
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
ReleaseObjects
End Sub
Private Sub ReleaseObjects()
Set oDoc = Nothing
End Sub
阅读(1840) | 评论(1) | 转发(0) |
