Problem
The problem happens when large files are split into several mails in MIME/B64 format in Outlook.
Even worse, the first part usually contains part of the original mail as it is a reply from another mail.
The format of that kind of mail is:
------=_NextPart_000_0011_01CB4DD5.B76D0860
Content-Type: application/octet-stream;
name="filename.rar"
Content-Transfer-Encoding: base64
Content-Disposition: attachment;
filename="filename.rar"
I've tried changing the format of mail from text to HTML and to RTF. It didn't work. I've tried a lot of things before finally deciding to join the b64 content of the mails in a file and converting from b64 to binary.
Solution
This is a macro for joining parts of a MIME / B64 file across multiple mails. It runs on Outlook using VBA.
The Code
Option Explicit
Sub MimeB64Joiner()
Dim myOlApp As Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim myItem As Outlook.MailItem
Dim myAttachment As Outlook.Attachment
Set myOlApp = Outlook.Application
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
Dim I As Integer
Dim NArch As Long, Pos As Long
NArch = FreeFile
Pos = 1
Open "C:\File.txt" For Binary Access Write As #NArch
For I = myOlSel.Count To 1 Step -1
'For I = 1 To myOlSel.Count
Set myItem = myOlSel.Item(I)
ProcessMail myItem, NArch, Pos
Next
Close NArch
MsgBox "Finished"
End Sub
Private Sub ProcessMail(myItem As Outlook.MailItem, NArch As Long, ByRef Pos As Long)
Dim arrLines() As String
Dim strLine As String
Dim I As Integer
Dim LastB64 As Boolean
LastB64 = False
arrLines = Split(myItem.Body, vbCrLf)
Dim EncStr() As Byte
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
' help from MSXML
Set objXML = New MSXML2.DOMDocument
Set objNode = objXML.createElement("b64")
objNode.dataType = "bin.base64"
For I = 0 To UBound(arrLines) - 1
strLine = arrLines(I)
If IsB64Line(strLine) And (Len(strLine) = 76 Or LastB64) Then
EncStr = DecodeBase64(strLine, objNode)
Put #NArch, Pos, EncStr
Pos = Pos + UBound(EncStr) + 1
Else
End If
If IsB64Line(strLine) And Len(strLine) = 76 Then
LastB64 = True
Else
LastB64 = False
End If
Next
Set objNode = Nothing
Set objXML = Nothing
End Sub
Private Function IsB64Line(strLine As String) As Boolean
Dim I As Integer
IsB64Line = False
If InStr(strLine, " ") <> 0 Then Exit Function
IsB64Line = True
End Function
Private Function DecodeBase64(ByVal strData As String, objNode As Variant) As Byte()
objNode.Text = strData
DecodeBase64 = objNode.nodeTypedValue
End Function
How to Use
Create a macro in Outlook. If using Outlook 2010, customize the ribbon for Developer. In the menu "Tools" "References", select "Microsoft XML" (any version).
Then paste the code and save. Select the mails you want to join and run the macro (
MimeB64Joiner
).
Limitations
As the program can't decide if a certain line is part of the b64 file or not, it uses the assumption that the line is 76 bytes long and it hasn't got spaces (non b64). The function
IsB64Line
is pretty basic and should be improved. The path and name of the file (
C:\File.txt) can be asked as a parameter also.