Visual Basic - Extraer adjuntos de correo eml

Private Sub VerContenido(Fichero As String)

    Dim Canal As Integer

    Dim Cadena As String

    Dim NombreArchivo As String

    Dim Contenido As String

    Dim Adjunto As String

    Dim t As Integer

    If Len(Fichero) = 0 Then Exit Sub

    NombreArchivo = ""

    Contenido = ""

    Adjunto = ""

    Canal = FreeFile()

    Open Fichero For Input As #Canal

    Do While Not EOF(Canal)

        'lee una linea del fichero origen

        Line Input #Canal, Cadena

	' Si la variable NombreArchivo esta vacia el contenido se añade a Contenido

        ' Aqui se guarda todo el mensaje del correo menos los adjuntos en txt

        If NombreArchivo = "" Then Contenido = Contenido + Cadena + Chr$(13) + Chr$(10)

        ' Si se ha encontrado el nombre de un adjunto

        ' el contenido del adjunto se guarda en la variable Adjunto

        If NombreArchivo <> "" Then

            If Cadena <> "" Then

                Adjunto = Adjunto + Cadena

            End If

        End If

	' Si encontramos "filename=" quiere decir que hay un adjunto

        t = InStr(LCase(Cadena), "filename=")

        If t > 0 Then

            NombreArchivo = Mid$(Cadena, t + 10)

            NombreArchivo = Left(NombreArchivo, Len(NombreArchivo) - 1)

        End If

    Loop

    Close #Canal    ' Cierra el archivo.

End Sub

' Codificar y Decodificar en BASE64

Public Function DecodeBase64(ByVal strData As String) As Byte()

    Dim objXML As Object

    Dim objNode As Object

    Set objXML = CreateObject("MSXML2.DOMDocument")

    Set objNode = objXML.createElement("b64")

    objNode.dataType = "bin.base64"

    objNode.Text = strData

    DecodeBase64 = objNode.nodeTypedValue

    Set objNode = Nothing

    Set objXML = Nothing

End Function

Public Function EnecodeBase64(ByVal strData As String) As Byte()

    Dim objStream As Object

    Dim objNode As Object

    Dim objXML As Object

    Dim bArray() As Byte

    Set objStream = CreateObject("ADODB.Stream")

    With objStream

        .Type = 2

        .Open

        .Charset = "unicode"

        .WriteText strData

        .Flush

        .Position = 0

        .Type = 1

        .read (2)

        bArray = .read

        .Close

    End With

    Set objXML = CreateObject("MSXML2.DOMDocument")

    Set objNode = objXML.createElement("b64")

    objNode.dataType = "bin.base64"

    objNode.nodeTypedValue = bArray

    EnecodeBase64 = objNode.Text

    Set objStream = Nothing

    Set objNode = Nothing

    Set objXML = Nothing

End Function