How would you output an XML file with an Ole Attachment?

[techneophyte]

I'm trying to output a query from Access 2007 into an XML file. However, I have to include an OLE Object in the XML file.



I've tried several methods and the closest I've come is scripting the output. However, when I get to xmloutput.write(sSQL), I get an invalid procedure error.

If I comment out the Ole Object everything works perfectly. Can I script the output of the OLE object into XML? If not what would be a better way?

I looked into using "Microsoft XML, v6" but didn't see anything that lets you add attachments.

I have a 3 day headache....can you help?

[Rawb]

There is no way to embed an OLE Object within an XML file. XML files are nothing more than plain text files with fancy extensions.

What you could possibly do is try to export the Object by itself (depending on what the Object's contents are) and then just make a link to it in the XML file.

[techneophyte]

Thanks Rawb....after a little more research I see that the OLE object needs to be encoded to a base64 bit encoded binary file....then that is included in the XML.
So now the question is....can the Base 64 bit coding be performed in VBA in Access 2007?

[Rawb]

Oooo! Base64 files!

Sounds like you're dealing with either encryption or e-mail! >.>

Function Base64Encode(inData)
  'rfc1521
  '2001 Antonin Foller, Motobit Software, http://Motobit.cz

  Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  Dim cOut, sOut, I

  'For each group of 3 bytes
  For I = 1 To Len(inData) Step 3
    Dim nGroup, pOut, sGroup

    'Create one long from this 3 bytes.
    nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
      &H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))

    'Oct splits the long To 8 groups with 3 bits
    nGroup = Oct(nGroup)

    'Add leading zeros
    nGroup = String(8 - Len(nGroup), "0") & nGroup

    'Convert To base64
    pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)

    'Add the part To OutPut string
    sOut = sOut + pOut

    'Add a new line For Each 76 chars In dest (76*3/4 = 57)
    'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
  Next
  Select Case Len(inData) Mod 3
    Case 1: '8 bit final
      sOut = Left(sOut, Len(sOut) - 2) + "=="
    Case 2: '16 bit final
      sOut = Left(sOut, Len(sOut) - 1) + "="
  End Select
  Base64Encode = sOut
End Function

Function MyASC(OneChar)
  If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function

[techneophyte]

This is Awesome Rawb! yes, this is a government agency requirement to submit attachments inside of an XML filing. I didn't see your answer before I posted a new one asking about encoding Spreadsheets and PDFs as well. Do you have any suggestions for that as well?

[hellboy]

I have the same question, but I want to split XML content from files

Export-ZIP-File:
XML file and many image files

[sac176]

techneophyte, were you able to get this working in Access? I believe we are working on the exact same request.

[techneophyte]

sac176...sorry for the delay, been out of town.
Yes....here's what we did
____________________________________

Public Function GenerateBinaryData(ByRef strPath As String) As String
'Dim strData As String
Dim ByteImage() As Byte
txtfiletoupload = strPath
' For Counter = 0 To UBound(ByteImage, 1)
If IsNull(txtfiletoupload) Or txtfiletoupload = "" Then
Exit Function
Else
Open txtfiletoupload For Binary Access Read As #1
ReDim ByteImage(1 To LOF(1))
Get #1, , ByteImage
Close #1
strData = EncodeBase64(ByteImage)
End If
'Next
End Function

Private Function EncodeBase64(ByRef arrData() As Byte) As String
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
' help from MSXML
Set objXML = New MSXML2.DOMDocument
' byte array to base64
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.nodeTypedValue = arrData
EncodeBase64 = objNode.Text
' thanks, bye
Set objNode = Nothing
Set objXML = Nothing
End Function