Ver Mensaje Individual
  #5 (permalink)  
Antiguo 01/09/2009, 13:16
mallu1983
 
Fecha de Ingreso: mayo-2009
Mensajes: 42
Antigüedad: 15 años, 9 meses
Puntos: 0
Respuesta: ¿DESESPERADA!!Porque me salen codigos raros en el cuerpo del mensaje?

Ok, ahí os va;

Codigo html:

strEnlace = VACIO
strEnlace = strEnlace & "<html xmlns='http://www.w3.org/1999/xhtml'>"
strEnlace = strEnlace & "<head><meta http-equiv='Content-Type' content='text/html;'/><style type='text/css'>"
strEnlace = strEnlace & "<!--"
strEnlace = strEnlace & ".Estilo2 {font-size: 9px; font-family: Arial; }"
strEnlace = strEnlace & ".Estilo5 {font-size: 9px; color: #0033FF;font-family: Arial; }"
strEnlace = strEnlace & "-->"
strEnlace = strEnlace & "</style>"
strEnlace = strEnlace & "</head>"
strEnlace = strEnlace & "<body>"
strEnlace = strEnlace & "<table width='663' class='Estilo2'>"
strEnlace = strEnlace & "<tr>"
strEnlace = strEnlace & "<td width='136'></td><td width='515'><img src='http://i340.photobucket.com/albums/o352/mallu1983/Logo.jpg' alt='Departamento de Sanidad y Consumo/Departamento de Educación, Universidades e Investigación' width='348' height='92' border='0'></td></tr></table><table width='599' border='0' class='Estilo2'><tr><td width='284' height='14'></td><td width='10'></td><td width='292'><p class='Estilo5'>" & entidad & "</p></td></tr></table><table width='598' height='360' border='0' class='Estilo2'>"
strEnlace = strEnlace & "<tr><td width='283' height='356'><p>&nbsp;</p>"
strEnlace = strEnlace & "<div>"
strEnlace = strEnlace & "<p>Vitoria-Gasteiz," & anio & "eko " & meseuskera & "ren " & dia & "a</p>"
strEnlace = strEnlace & "<p>" & strTexto1 & "</p>"
strEnlace = strEnlace & "<p align='justify'>" & strTexto2 & "</p>"
strEnlace = strEnlace & "<p>" & strTexto3 & "</p>"
strEnlace = strEnlace & "<ul>"
strEnlace = strEnlace & "<li>" & strTexto4 & "</li>"
strEnlace = strEnlace & "<li>" & strTexto5 & "</li>"
strEnlace = strEnlace & "<li>" & strTexto6 & "</li>"
strEnlace = strEnlace & "</ul>"
strEnlace = strEnlace & "<p>&nbsp;</p>"
strEnlace = strEnlace & "</div>"
strEnlace = strEnlace & "</td><td width='10'></td><td width='291'><p>&nbsp;</p>"
strEnlace = strEnlace & "<div>"
strEnlace = strEnlace & "<p>Vitoria-Gasteiz,a " & dia & " de " & mescastellano & " de " & anio & "</p>"
strEnlace = strEnlace & "<p>" & strTexto21 & "</p>"
strEnlace = strEnlace & "<p align='justify'>" & strTexto22 & "</p>"
strEnlace = strEnlace & "<p>" & strTexto23 & "</p>"
strEnlace = strEnlace & "<ul>"
strEnlace = strEnlace & "<li>" & strTexto24 & "</li>"
strEnlace = strEnlace & "<li>" & strTexto25 & "</li>"
strEnlace = strEnlace & "<li>"
strEnlace = strEnlace & "<div align='justify'>" & strTexto26 & "</div>"
strEnlace = strEnlace & "</li>"
strEnlace = strEnlace & "</ul>"
strEnlace = strEnlace & "<p>&nbsp;</p>"
strEnlace = strEnlace & "</div>"
strEnlace = strEnlace & "</td>"
strEnlace = strEnlace & "</tr></table><table width='598' border='0' class='Estilo2'><tr><td width='271' height='437'>"
strEnlace = strEnlace & "<p>" & strTexto7 & "<a href='http://www.kontsumo.net/'>www.kontsumo.net</a></p>"
strEnlace = strEnlace & "<p>" & strTexto8 & "<a href='http://www.kontsumo.net/'>www.kontsumo.net</a></p>"
strEnlace = strEnlace & "<p>" & strTexto9 & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;& nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nb sp;"
strEnlace = strEnlace & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;& nbsp;&nbsp;&nbsp;&nbsp;</p>"
strEnlace = strEnlace & "<p><span>- Erabiltzailea: &nbsp; </span><span class='Estilo5'>" & Usuario & "</span><br/>"
strEnlace = strEnlace & "<span>- Pasword: &nbsp;<span> &nbsp;&nbsp;&nbsp; </span><span class='Estilo5'>" & PASWORD & "</span></span></p>Argibiderik behar izanez gero:<br/>Telefonoa: 945.01.99.88/24 <br/>E-mail: <a href='mailto:[email protected]'>[email protected]</a> / <a href='mailto:[email protected]'>[email protected]</a>"
strEnlace = strEnlace & "</p>"
strEnlace = strEnlace & "<p>" & strTexto10 & "</p>"
strEnlace = strEnlace & "<p>" & strTexto11 & "</p>"
strEnlace = strEnlace & "<ul>"
strEnlace = strEnlace & "<li>" & strTexto12 & "<br/>"
strEnlace = strEnlace & "</li>"
strEnlace = strEnlace & "<li>" & strTexto13 & "</li>"
strEnlace = strEnlace & "</ul>"
strEnlace = strEnlace & "<p>" & strTexto14 & "</p>"
strEnlace = strEnlace & "<br/></td></tr></table></body></html>"

Recogerlo y enviarlo:

BODY = strEnlace

Private Sub FormatMSG()
NotificadorSMTP.Refresh
Dim d As Byte
Dim fileB64 As String
If Dir(App.Path & "\email.eml") <> "" Then Kill (App.Path & "\email.eml")
Call WriteStatus("Formando Mensaje...." & vbCrLf)
Asunto = SUBJECT
remitente = REMI_DES & " <" & REMI_VAR & ">"
str1 = DEST_VAR
pos = InStr(1, DEST_VAR, ";", vbTextCompare)
While Not pos = 0
Mid(DEST_VAR, pos, 1) = ", "
pos = InStr(pos + 1, DEST_VAR, ";", vbTextCompare)
Wend
destinatario = DEST_VAR
DEST_VAR = str1
'MsgBox FILES_VAR
mailstring = "From: " & remitente & vbCrLf & "To: " & destinatario & vbCrLf & "Subject: " & Asunto & vbCrLf & Text6.Text & vbCrLf & Text2.Text & vbCrLf & Text3.Text & vbCrLf & BODY & vbCrLf & vbCrLf
If Len(FILES_VAR) = 0 Then
mailstring = mailstring & vbcrl & Text2.Text & "--"
EMLFILE = FreeFile
Open App.Path & "\email.eml" For Binary As EMLFILE
ProgressBar1.Max = Len(mailstring) + 10
ProgressBar1.Value = 0
For t = 1 To Len(mailstring)
Put EMLFILE, , CByte(Asc(Mid(mailstring, t, 1)))
Next
Close (EMLFILE)
Else
EMLFILE = FreeFile
Open App.Path & "\email.eml" For Binary As EMLFILE
ProgressBar1.Max = Len(mailstring) + 10
ProgressBar1.Value = 0
For t = 1 To Len(mailstring)
Put EMLFILE, , CByte(Asc(Mid(mailstring, t, 1)))
Next
mailstring = ""
pos = InStr(1, FILES_VAR, ";", vbTextCompare)
While pos <> 0
pfile = Mid(FILES_VAR, 1, pos - 1)
FILES_VAR = Right(FILES_VAR, Len(FILES_VAR) - (Len(pfile) + 1))
If Dir(pfile) <> "" Then
For t = 0 To Len(pfile) - 1
pfname = Mid(pfile, Len(pfile) - t, t)
If Left(pfname, 1) = "\" Then
pfname = Right(pfile, t)
Exit For
End If
Next
Call WriteStatus("Adjuntando " & pfname & "...." & vbCrLf)
mailstring = mailstring & vbcrl & Text2.Text & vbCrLf
mailstring = mailstring & Left(Text4.Text, Len(Text4.Text) - 2) & Chr(34) & pfname & Chr(34) & vbCrLf
mailstring = mailstring & Left(Text5.Text, Len(Text5.Text) - 2) & Chr(34) & pfname & Chr(34) & vbCrLf & vbCrLf
For t = 1 To Len(mailstring)
Put EMLFILE, , CByte(Asc(Mid(mailstring, t, 1)))
Next
mailstring = ""
Call FileCodB64(CStr(pfile))
End If
pos = InStr(1, FILES_VAR, ";", vbTextCompare)
Wend

pfile = Trim(FILES_VAR)
If Dir(pfile) <> "" Then
For t = 0 To Len(pfile) - 1
pfname = Mid(pfile, Len(pfile) - t, t)
If Left(pfname, 1) = "\" Then
pfname = Right(pfile, t)
Exit For
End If
Next
Call WriteStatus("Adjuntando " & pfname & "...." & vbCrLf)
mailstring = mailstring & vbcrl & Text2.Text & vbCrLf
mailstring = mailstring & Left(Text4.Text, Len(Text4.Text) - 2) & Chr(34) & pfname & Chr(34) & vbCrLf
mailstring = mailstring & Left(Text5.Text, Len(Text5.Text) - 2) & Chr(34) & pfname & Chr(34) & vbCrLf & vbCrLf
For t = 1 To Len(mailstring)
Put EMLFILE, , CByte(Asc(Mid(mailstring, t, 1)))
Next
mailstring = ""
Call FileCodB64(CStr(pfile))

End If
mailstring = mailstring & vbCrLf & Text2.Text & "--"
For t = 1 To Len(mailstring)
Put EMLFILE, , CByte(Asc(Mid(mailstring, t, 1)))
Next
mailstring = ""
End If
Close (EMLFILE)
'enviar mensajes SMTP a los Destinatarios
Call WriteStatus("Asignando Destinatarios...." & vbCrLf)
pos = InStr(1, DEST_VAR, ";", vbTextCompare)
While Not pos = 0
Mid(DEST_VAR, pos, 1) = " "
pos = InStr(pos + 1, DEST_VAR, ";", vbTextCompare)
Wend
rcpt = DEST_VAR
Call WriteStatus("Enviando...." & vbCrLf)
Call SendSMTPMsg(Trim(rcpt))
End Sub

Private Sub SendMsg()
Dim d As Byte
Dim lin As String
lin = ""
ProgressBar1.Max = FileLen(App.Path & "\email.eml") + 60
ProgressBar1.Value = 0
pfile = FreeFile
Open App.Path & "\email.eml" For Binary As pfile
t = 0
While Not EOF(pfile)
t = t + 1
Get pfile, , d
lin = lin & Chr(CLng(d))
If Right(lin, 2) = vbCrLf Then
wsk.SendData (lin)
ProgressBar1.Value = t
lin = ""
End If
Wend
Close (pfile)
wsk.SendData (vbCrLf & vbCrLf & "." & vbCrLf)
ProgressBar1.Value = ProgressBar1.Max
End Sub
Private Sub SendSMTPMsg(rcpt)
PASO = 0
If wsk.State = sckClosed Then
ORIG = REMI_VAR
DEST = rcpt
wsk.Protocol = sckTCPProtocol
wsk.RemoteHost = SMTP_SERVER
wsk.RemotePort = SMTP_PORT
wsk.Connect
End If
End Sub