InfoPath [IP] 문서를 보관하고 있습니다. 데이터는 MS Access 2010에 저장 될 것입니다 (파일 시스템의 첨부 파일과 함께 Access DB에 대한 참조가 저장 됨).VBA를 사용하여 InfoPath 첨부 파일 추출
IP 양식에 포함 된 파일을 추출하기 위해 하나의 VBA 솔루션을 찾았지만 작동하지 않습니다. (http://www.infopathdev.com/forums/p/10182/36240.aspx)
많은 .NET 솔루션을 찾았지만 VBA로 변환 할 수있는 행운이 없었습니다.
IP 첨부 노드에 포함 된 파일 내용을 & 파일명으로 취하고 (Access의 VBA를 사용하여) 파일 시스템에 저장된 실제 파일을 어떻게 만들 수 있습니까?
InfoPath 첨부 파일은 base64로 인코딩됩니다. 인코딩을 "언팩"할 수 있습니다.
' The MSXML2.DOMDocument class has methods to
' convert a base64—encoded string to a byte array.
Private Function DecodeBase64(ByVal strData As String) As Byte()
Dim obj_XML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
' Getting help from MSXML
Set obj_XML = New MSXML2.DOMDocument
Set objNode = obj_XML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.Text = strData
' Return the value
DecodeBase64 = objNode.nodeTypedValue
Set objNode = Nothing
Set obj_XML = Nothing
End Function
바이트 배열의 처음 16 바이트는 쓸모없는 헤더입니다.
다음 4 바이트는 실제 파일 크기의 little-endian 부호없는 정수입니다. 이 정보는 불필요합니다.
다음 4 바이트는 FileName의 문자 수 중 little-endian 부호없는 정수입니다. FileName은 UniCode에 있으므로 2 바이트/문자입니다. 따라서 FileName 크기의 수에 2를 곱합니다. 이름은 제거해야 할 끝에 null이 있습니다.
마지막으로 그 시점 이후의 나머지 부분이 파일입니다.
헬퍼 클래스를 만들어 첨부 파일의 바이트 배열을 분할하기로 결정했습니다. 내 클래스는 바이트 배열과 숫자를 사용합니다. 입력 배열은 위쪽과 아래쪽 반쪽을 나타내는 2 개의 속성으로 나뉩니다. 입력 된 숫자는 1) 맨 아래 배열의 바이트 수 및 2) 맨 위 부분에 입력 할 입력 된 배열의 첫 번째 바이트 인덱스입니다.
처음에는 전체 첨부 파일을 제공하고 객체에 추가하여 23으로 분할했습니다. 헤더와 파일 크기 바이트 및 파일 이름 크기를 넣고 맨 아래 배열에 넣고 파일 이름 파일 내용을 확인하고 맨 위에 넣습니다.
두 개의 배열을 참조하고 (그 배열을 유지하기 위해) 맨 아래 배열을 객체로 가져 와서 19로 나눕니다. 파일 이름이 맨 위에 오도록 바닥을 버립니다.
Long로 변환 한 후 FileNameSize 시간 2의 값으로 분할하여 객체의 위쪽 부분을 가져옵니다. 따라서 파일 이름은 맨 아래에 있고 파일은 맨 위에 있습니다.
두 개의 사용자 정의 유형을 사용하여 FileName 크기의 4 바이트를 하나의 연속 된 4 바이트로 정렬하고 다른 UDT를 단일 long으로 처리합니다. LSet 문을 사용하여 1 차 UDT의 4 연속 바이트를 2 차 UDT의 4 연속 바이트에 복사합니다. 바이트를 long으로 변환합니다.
VBA는 UniCode 바이트의 바이트 배열과 같은 문자열을 설정하면 자동으로 바이트 배열을 문자열로 변환합니다.
마지막으로 위쪽 배열은 넣기를 사용하여 파일에 복사됩니다.
클래스 :
Private pLow() As Byte
Private pHigh() As Byte
Private src() As Byte
Private pt As Long
Public Property Get Low() As Byte(): Low = pLow: End Property
Public Property Get High() As Byte(): High = pHigh: End Property
Private Function outOfBounds() As Boolean
Dim msg As String
' Check the bounds
If pt < 0 Then _
msg = "Division point cannot be less than zero"
If pt > (UBound(src) + 1) Then ' When = UBound + 1, copy whole array into pLo
msg = "‘point’ is greater the the size of the array."
End If
If msg <> "" Then
outOfBounds = True
src = Null
Err.Raise vbObjectError + 6, msg
End If
End Function
' point is the index of the 1st element to be copied into pHi
Public Sub Load(SrcArr() As Byte, point As Long)
src = SrcArr ' grant class-wide access.
pt = point ' grant class-wide access.
If outOfBounds() Then Exit Sub
' Create new arrays and assign to private fields
Dim L() As Byte
Dim H() As Byte
Dim hiUB As Long
hiUB = UBound(src) - point
If point <> 0 Then ' <————<< If ‘point’ is 0, then this is just going to be a copy of
ReDim L(point - 1) ' the whole array into pHi; don’t initialize pLo.
End If
If point <> (UBound(src) + 1) Then ' <————<< If it is the SIZE of the array (UBound+1), then this is
ReDim H(hiUB) ' just going to be a copy of the whole array into pLo, so
End If ' there would be no need to initialize pHi.
' Do the two copies
If point <> 0 Then _
MoveMemory L(0), src(0), point ' ‘point’ is the 0-based 1st element to copy into pHi. So it
' also serves as the 1-based copy SIZE, for copying into pLo.
If point <> (UBound(src) + 1) Then _
MoveMemory H(0), src(point), (hiUB + 1)
pLow = L
pHigh = H
End Sub
처리 :
Public Sub processAttachment(dataIn As String, Optional path As String)
On Error GoTo Er
' After development, remove this:
If IsMissing(path) Or path = "" Then path = "had a default here"
Dim fNum As Integer ' File number, for file communication.
Dim fName As String
Dim fNamSz As Long
Dim b_Tmp() As Byte
Dim btArr() As Byte
btArr = DecodeBase64(dataIn) ' <————<<< dataIn is a base64-encoded string. Convert it to a byte array.
Dim cAS As New clsArraySplitter ' Instantiate the class for getting array sections.
cAS.Load btArr, 24 ' Separate the data at the beginning of btArr (whose size is set), from the
btArr = cAS.High ' rest of the data (whose sizes will be different for each attachment).
' Header (16 bytes, 0-15) + 2, 4-byte long int.s = 16 + 4 + 4 = 24.
' Set the dymaically-sized portion of the data (fName & the file) aside, for now.
cAS.Load cAS.Low, 16 ' Dump Hdr; puts part to be dumped in .Low, 2 longs in .High
' Now .Low has header to be dumped; just ignore it,
' .High has fSize & fNameSize (8 bytes, total).
cAS.Load cAS.High, 4 ' Now .Low has fSize (4 bytes; I don't need this info),
' .High has fNameSize (4 bytes).
fNamSz = ByteArrayToLong(cAS.High) ' Get FileName character count
fNamSz = fNamSz * 2 ' UniCode has 2-bytes per character
' Now, refocus on the array having fname & file.
' Separate into 2 parts, the file name, and the file.
cAS.Load btArr, fNamSz ' Now .Low has the fName,
' .High has the file.
' Get fName, then trim null(s) off the right end.
fName = Trim(cAS.Low) ' VB handles this Byte array to string conversion.
Dim pos As Integer
pos = InStr(fName, Chr$(0)) ' No matter how many, pos points at the 1st one.
If pos > 0 Then _
fName = Left$(fName, pos - 1)
' Open output byte array to a file, then close the file.
' I need to check for the existence of the file, and add '(n)' to the filename if it already exists.
' Since attachments are not stored in the XML by name, InfoPath can store attachments with exactly the same name
' (with or w/o different contents) any # of times. Since I’m saving to the file system, I can’t do that.
fName = UniqueFileName(path, fName)
path = path & fName
fNum = FreeFile
Open path For Binary Access Write As fNum
Put fNum, , cAS.High
Rs: Close fNum ' This ‘Close’ is put here, at the resume point, so that it is sure to be closed
Exit Sub
Er: MsgBox "Error, """ & Err.Description & ","" in ""processAttachment()."""
Resume Rs
End Sub
희망하는 모든 형식 좋아. . .