hola espero y este codigo te sirva para tu problema.
Dim Enter ' Voy a utilizar variable global Enter
Private Sub ArchivoAdjunto()
On Error Resume Next ' Detector de Errores Activado
Destino = "Temporal.uue" ' Determinar el Destino
' Esto que sigue es codificar el Archivo adjunto
' para que lo pueda leer el lector de Mails
' Utilizo la codificacion UUE y aclaro que
' lo de a continuacion no es mio
Open Archivo For Binary As #1
Open Destino For Output As #2
Print #2, "begin 644 " + Archivo
bl& = 45: fl& = LOF(1): bf$ = Space$(bl&)
While fl&
If fl& < bl& Then bl& = fl&: bf$ = Space$(bl&)
Get #1, , bf$: fl& = fl& - bl&
If bl& Mod 3 <> 0 Then bf$ = bf$ + String$(3 - bl& Mod 3, 0)
For i = 1 To bl& Step 3
c1 = Asc(Mid$(bf$, i, 1))
c2 = Asc(Mid$(bf$, i + 1, 1))
c3 = Asc(Mid$(bf$, i + 2, 1))
l$ = l$ + Chr$(c1 \ 4 + 32)
l$ = l$ + Chr$((c1 * 16 + c2 \ 16 And &H3F) + 32)
l$ = l$ + Chr$((c2 * 4 + c3 \ 64 And &H3F) + 32)
l$ = l$ + Chr$((c3 And &H3F) + 32)
Next
Print #2, Chr$(32 + bl&); l$: l$ = ""
Wend
Print #2,: Print #2, "end"
Close #1, #2
' Lo siguiente si es mio
ArchivoUUE = "" ' Inicializo la variable
Open Destino For Input As #1 ' Abro el archivo
Do
For i = 1 To 100 ' Leo 100 Lineas y las envio
Line Input #1, Linea ' Leo Linea por Linea
If Linea = "" Then ' Si la Linea esta vacia
Exit For ' Salirse el For
End If
If Linea = "end" Then ' Si Linea es "end"
ArchivoUUE = ArchivoUUE + Linea & Enter ' Agregarla
Exit For ' Salir del For
End If
ArchivoUUE = ArchivoUUE + Linea & Enter ' Ir almacenando las Lineas
Next
Sock1.SendData ArchivoUUE ' Envio el ArchivoUUE
ArchivoUUE = "" ' Lo dejo en limpio
Loop Until EOF(1) ' Repetir hasta que llegue al final del archivo
Close #1 ' Cierro el Destino
End Sub
Private Sub Agregar_Click()
Com1.FileName = "" ' Borrar anterior archivo
Com1.ShowOpen ' Mostrar dialogo Abrir
If Com1.FileName > "" Then ' Si elegiste un Archivo
Archivo = Com1.FileName ' Ponerlo en el TextBox Archivo
Eliminar.Enabled = True ' Poder presionar Eliminar (X)
End If
End Sub
Private Sub Cerrar_Click()
On Error Resume Next ' Detector de Errores Activado
Sock1.Close ' Cerramos la conexion
End ' Finalizamos
End Sub
Private Sub Eliminar_Click()
Archivo = "Ninguno..." ' Indicar que no hay archivo adjunto
Eliminar.Enabled = False ' No poder presionar Eliminar (X)
End Sub
Private Sub Enviar_Click()
On Error Resume Next ' Detector de Errores Activado
If Sock1.State <> 0 Then ' Si tiene una conexion abierta
Sock1.Close ' Cerrar la conexion
End If
Screen.MousePointer = 11 ' Cambiar el mouse a espera
Sock1.RemoteHost = Servidor ' Le digo cual es el Servidor de SMTP
Sock1.RemotePort = 25 ' El puerto a donde conectarse (SMTP)
Recibidos = "" ' Limpiar Datos Recibidos
Sock1.Connect ' Intenta la conexion...
Enter = Chr(13) + Chr(10) ' Inicializo la variable global Enter
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error Resume Next ' Detector de Errores Activado
Sock1.Close ' Cerramos la conexion
End Sub
Private Sub Sock1_Connect()
On Error Resume Next ' Detector de Errores Activado
Sock1.Tag = 1 ' Pongo que voy en el paso 1
Sock1.SendData "HELO " & Nombre & Enter ' Le envio un comando al Servidor y 1 Enter
End Sub
Private Sub Sock1_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next ' Detector de Errores Activado
Sock1.GetData Datos, vbString ' Recibir en Datos
Recibidos = Recibidos + Datos ' Ponerlo en el TextBox
If Mid(Datos, 1, 9) = "550 Relay" Then ' Revisar si permite Relay
MsgBox "Ese Servidor no permite enviar mails sin cuenta", vbOKOnly + vbCritical, "Error" ' Mostrar mensaje
Sock1.Close ' Cerrar conexion
Sock1.Tag = 0 ' Digo que ya se acabo
End If
If Sock1.Tag = 1 Then ' Si voy en el paso 1
Sock1.SendData "RSET" & Enter ' Le envio RSET
Sock1.Tag = 2 ' Digo que voy al siguiente paso
GoTo fin ' Ir al final
End If
If Sock1.Tag = 2 Then ' Si voy en el paso 2
Sock1.SendData "MAIL FROM: <" & MiMail & ">" & Enter ' Le envio MiMail1
Sock1.Tag = 3 ' Digo que voy al siguiente paso
GoTo fin ' Ir al final
End If
If Sock1.Tag = 3 Then ' Si voy en el paso 3
Sock1.SendData "RCPT TO: <" & ParaMail & ">" & Enter ' Le envio ParaMail
If CCMail <> "-" Then ' Si tiene para un Mail CC (con copia, creo)
Sock1.SendData "RCPT TO: <" & CCMail & ">" & Enter ' Le envio CCMail
End If
Sock1.Tag = 4 ' Digo que voy al siguiente paso
GoTo fin ' Ir al final
End If
If Sock1.Tag = 4 Then ' Si voy en el paso 4
Sock1.SendData "DATA" & Enter ' Aqui le envio DATA (Empieza el mail)
Sock1.Tag = 5 ' Digo que voy al siguiente paso
GoTo fin ' Ir al final
End If
If Sock1.Tag = 5 Then ' Si voy en el paso 5
Sock1.SendData "To: " & ParaMail & Enter ' Le envio para quien va
If CCMail <> "-" Then ' Si tiene para un Mail CC (con copia, creo)
Sock1.SendData "CC: " & CCMail & Enter ' Le envio para quien va el CC
End If
Sock1.SendData "From: " & Nombre & " <" & MiMail & ">" & Enter ' El Nombre y MiMail
Sock1.SendData "Subject: " & Titulo & Enter ' El Subject (Titulo)
Sock1.SendData Enter ' Un Enter indica que empieza el Mensaje
Sock1.SendData Mensaje & Enter ' Le envio el Mensaje
If Archivo <> "Ninguno..." Then ' Si tengo un archivo adjunto
Call ArchivoAdjunto ' Llamo al Procedimiento de Anviar Archivo
End If
Sock1.SendData "." & Enter ' Esto indica fin del mail
Sock1.Tag = 6 ' Digo que voy al siguiente paso
GoTo fin ' Ir al final
End If
If Sock1.Tag = 6 Then ' Si voy en el paso 6
Sock1.SendData "QUIT" & Enter ' Le indico que cierre la conexion
Sock1.Tag = 7 ' Digo que voy al ultimo paso
GoTo fin ' Ir al final
End If
If Sock1.Tag = 7 Then ' Si voy en el paso 6
Sock1.Tag = 0 ' Digo que ya se acabo
Sock1.Close ' Cierro la conexion
Screen.MousePointer = 0 ' Poner el mouse normal
MsgBox "Mail enviado", vbOKOnly + vbInformation, "=)" ' Mostar un mensaje
GoTo fin ' Ir al final
End If
fin:
End Sub
Private Sub Sock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Screen.MousePointer = 0 ' Poner el mouse normal
If Number = 11004 Then ' Si el Numero de error es el 11004
MsgBox "No existe el Servidor", vbOKOnly + vbExclamation, "Error"
GoTo fin ' Ir al final
End If
If Number = 10060 Then ' Si el Numero de error es el 10060
MsgBox "Tiempo agotado para conexion", vbOKOnly + vbExclamation, "Error"
GoTo fin ' Ir al final
End If
If Number = 10065 Then ' Si el Numero de error es el 10065
MsgBox "Sin ruta al Servidor", vbOKOnly + vbExclamation, "Error"
GoTo fin ' Ir al final
End If
MsgBox Number & " - " & Description ' Mostrar mensaje de Error
fin:
End Sub
Private Sub Timer1_Timer()
On Error Resume Next ' Detector de Errores Activado
Select Case Sock1.State ' Seleccionar el Estado del Socket
Case 0
Estado = "Cerrado"
Case 1
Estado = "Abierto"
Case 2
Estado = "Escuchando..."
Case 3
Estado = "Pendiente"
Case 4
Estado = "Resolviendo Host..."
Case 5
Estado = "Host Resuelto"
Case 6
Estado = "Conectando..."
Case 7
Estado = "Conectado"
Case 8
Estado = "Conexion Cerrada"
Case 9
Estado = "Error"
End Select
End Sub
yo tenia la misma duda o si lo deceas mandame un correo y te mando uno que hice yo.
