doy mas información, porque no consigo hacerlo, creo que la idea la tengo pero no me centro, estoy con una medicación fuerte para la ansiedad y la depresión que no me deja pensar.
1. la idea es abrir el fichero .eml y recorrerlo hasta encontrar "filename=" que contiene el nombre del adjunto, algo asi:
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
2. Ahora tenemos dos variables, Contenido con todo el mensaje menos los adjuntos que se guardaria como aguaococacola.txt y la variable Adjunto que contiene el adjunto codificado en Base64, habria que pasar esa codificación a binario y guardarla como aguaococacola.pps, para eso he encontrado estas funciones:
' 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
3. Si hay varios adjuntos se tiene que repetir el proceso.
a). Tengo problemas para encontrar el final del adjunto.
b). No sé como pasar la variable Adjunto para que funcione la decodificacion Base64
c). No sé como guardar el archivo Adjunto una vez pasado a binario.
He intentado varias cosas pero todas me dan error. Alguien me puede ayudar
Gracias, un saludo.
Mostrar Mensajes
