Enviar correo con vb

He relizado un programa que envia un fichero a traves de correo electronico, el problema que tengo es que cuando envio el correo se me queda en la bandeja de salida del outlook, hay alguna manera para que me envie el correo directamente sin tener que abrir el outlook
1

1 Respuesta

6.475 pts.
Este es un formulario pasado en modo texto. Lo mas conveniente seria que lo imprimieras para que puedas ver que controles tiene y asi no generar un error.
----Comienzo del codigo----
VERSION 5.00
Object = "{20C62CAE-15DA-101B-B9A8-444553540000}#1.1#0"; "MSMAPI32.OCX"
Begin VB.Form frmEMail
BorderStyle = 1 'Fixed Single
Caption = "Ejemplo de E-mail"
ClientHeight = 5316
ClientLeft = 48
ClientTop = 336
ClientWidth = 10200
Icon = "frmEmail.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5316
ScaleWidth = 10200
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton BtnVer
Caption = "&Ver Archivos a enviar"
Height = 495
Left = 6720
TabIndex = 11
Top = 4440
Width = 2175
End
Begin VB.TextBox TxtMensaje
Height = 960
Left = 5280
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 9
Top = 3120
Width = 4815
End
Begin VB.TextBox TxtSubject
Height = 300
Left = 5280
TabIndex = 7
Top = 2760
Width = 4815
End
Begin VB.TextBox TxtDestinatario
Height = 300
Left = 5280
TabIndex = 6
Top = 2400
Width = 4815
End
Begin VB.CommandButton cmdEnviar
Caption = "&Enviar"
Enabled = 0 'False
Height = 495
Left = 9000
TabIndex = 4
Top = 4440
Width = 885
End
Begin VB.FileListBox File1
Height = 1608
Left = 6360
MultiSelect = 2 'Extended
TabIndex = 1
Top = 240
Width = 3000
End
Begin VB.DirListBox Dir1
Height = 1215
Left = 2040
TabIndex = 3
Top = 660
Width = 4200
End
Begin VB.DriveListBox Drive1
Height = 315
Left = 2055
TabIndex = 2
Top = 270
Width = 4200
End
Begin VB.CommandButton cmdPreparar
Caption = "&Preparar"
Height = 495
Left = 5760
TabIndex = 0
Top = 4440
Width = 885
End
Begin MSMAPI.MAPISession MAPISession1
Left = 588
Top = 0
_ExtentX = 804
_ExtentY = 804
_Version = 393216
DownloadMail = -1 'True
LogonUI = -1 'True
NewSession = 0 'False
End
Begin MSMAPI.MAPIMessages MAPIMessages1
Left = 0
Top = 12
_ExtentX = 804
_ExtentY = 804
_Version = 393216
AddressEditFieldCount= 1
AddressModifiable= 0 'False
AddressResolveUI= 0 'False
FetchSorted = 0 'False
FetchUnreadOnly = 0 'False
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "Mensaje"
Height = 195
Left = 4320
TabIndex = 10
Top = 3240
Width = 600
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "Asunto"
Height = 195
Left = 4320
TabIndex = 8
Top = 2760
Width = 495
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Destinatario"
Height = 195
Left = 4320
TabIndex = 5
Top = 2520
Width = 840
End
End
Attribute VB_Name = "frmEMail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub BtnVer_Click()
'muestra los archivos a enviar
Dim Bandera As Boolean
Dim n As Double
Dim Cadena As String
Bandera = False
For n = 0 To File1.ListCount - 1
If File1.Selected(n) Then
Bandera = True
Exit For
End If
Next n
If Bandera Then
For n = 0 To File1.ListCount - 1
If File1.Selected(n) Then
If Cadena = "" Then
Cadena = Cadena & File1.List(n)
Else
Cadena = Cadena & Chr(13) & File1.List(n)
End If
End If
Next n
MsgBox Cadena, vbOKOnly + vbInformation, "Ficheros a enviar"
End If
End Sub
Private Sub cmdPreparar_Click()
On Error GoTo ErrorPreparar
Dim n As Double
Dim camino As String
Dim r As Integer
Dim Bandera As Boolean
Me.MousePointer = 11
'Comprueba los datos del mensaje
If TxtDestinatario.Text = "" Then
MsgBox "Indique el destinatario", vbOKOnly + vbExclamation, "Aviso"
TxtDestinatario.SetFocus
Exit Sub
ElseIf TxtSubject.Text = "" Then
MsgBox "Indique el asunto", vbOKOnly + vbExclamation, "Aviso"
TxtSubject.SetFocus
Exit Sub
End If
If TxtMensaje.Text = "" Then
R = MsgBox("El envio va sin mensaje, si desea enviarlo de todas formar pulse Si, en caso contrario pulse No", vbYesNo + vbQuestion, "Aviso")
If r <> 6 Then Exit Sub
End If
'Preparar el envio
MAPISession1.UserName = "El emisor de ficheros"
MAPISession1.NewSession = True
MAPISession1.DownLoadMail = False ' o false si no deseas recibir
MAPISession1.SignOn
MAPIMessages1.SessionID = MAPISession1.SessionID
If Right(File1.Path, 1) = "" Then
camino = File1.Path
Else
camino = File1.Path & ""
End If
'Comprueba si hay algun fichero seleccionado
Bandera = False
For n = 0 To File1.ListCount - 1
If File1.Selected(n) Then
Bandera = True
Exit For
End If
Next n
If Bandera Then
For n = 0 To File1.ListCount - 1
If File1.Selected(n) = True Then
MAPIMessages1.MsgIndex = -1 ' nuevo...

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas