MIME / B64 Outlook attachment joiner

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.