ENVIAR EMAIL VIA FORMUL?RIO VB

MILTONSILVA94 17/08/2016 20:25:10
#465908
Boa noite a todos,

Estou adaptando o seguinte formulário para envio de email:
Fonte: http://www.macoratti.net/vb_email.htm

Private Sub cmdEnviar_Click()

Dim sucesso As Boolean
Dim mensagem As String
Dim mailer As SMTPsvg.mailer

Set mailer = CreateObject([Ô]SMTPsvg.Mailer[Ô]) [ô]- Conexão com a dll do servidor

[ô]mailer.RemoteHost = [Ô]smtp.Live.com[Ô] [ô]Local onde você colocará o smtp.
mailer.RemoteHost = [Ô]mail.seuservidorsmtp.com.br[Ô] [ô]Local onde você colocará o smtp.

mailer.FromName = txtremetente [ô]- Procura no form o nome colocado
mailer.FromAddress = txtemailremetente [ô]- Procura no form o e-mail colocado
mailer.AddRecipient txtdestino, txtemaildestino [ô]- O nome de quem está enviando e o E-mail
mailer.Subject = txtassunto [ô]- Procura no form o assunto colocado

mailer.BodyText = txtTexto [ô]- Procura no form o texto colocado

sucesso = mailer.SendMail

If sucesso Then
mensagem = [Ô]O E-MAIL ENVIADO COM SUCESSO![Ô]
Else
mensagem = [Ô]O E-MAIL NÃO FOI ENVIADO COM SUCESSO![Ô]
End If

MsgBox mensagem, vbInformation, [Ô]Enviando emails usando ASPMAIL[Ô]

End Sub


Como configuro a conexão para que o email chegue no destinatário, pois desta forma quando clico em [ô]mandar o email[ô], sempre me retorna na mensagem [ô]O E-MAIL NÃO FOI ENVIADO COM SUCESSO![ô].
O que ainda falta?
KURTGU 17/08/2016 20:37:06
#465909
Isso é vb6 mude o tópico pois está em vb.net...
MILTONSILVA94 17/08/2016 20:41:15
#465910
Citação:

:
Isso é vb6 mude o tópico pois está em vb.net...



Aham, mudei
FABRICIOWEB 18/08/2016 08:30:36
#465930
[txt-color=#e80000]Botão enviar [/txt-color]


[txt-color=#e80000]Adicionar a referencia [/txt-color]

microsoft CDO for windows



Private Sub cmdSend_Click()
On Error Resume Next
Dim RetVal As String
Dim objControl As Control
For Each objControl In Me.Controls
If TypeOf objControl Is TextBox Then
If Trim$(objControl.Text) = vbNullString And LCase$(objControl.Name) <> [Ô]txtattach[Ô] Then
msgbox [Ô]Todos os campos são requeridos![Ô]
Exit Sub
End If
End If
Next
me.Caption = [Ô]Enviando...[Ô]

RetVal = SendMail(Trim$(txtTo.Text), _ [ô]email para
Trim$(txtSubject.Text), _ [ô]assunto
Trim$(txtFromName.Text) & [Ô]<[Ô] & Trim$(txtFromEmail.Text) & [Ô]>[Ô], _ [ô] nome do remetente [ô] email do remetente
Trim$(txtMsg.Text), _ [ô] menssagem
Trim$(txtServer.Text), _ [ô] server seja la qual for
CInt(Trim$(txtPort.Text)), _ [ô] porta seja la qual for
Trim$(txtUsername.Text), _ [ô] seu usuário para login
Trim$(txtPassword.Text), _ [ô] sua senha
lstAnexos, _ [ô]lista de anexos
CBool(chkSSL.Value))
cmdSend.Enabled = True
msgbox IIf(RetVal = [Ô]ok[Ô], [Ô]Menssagem Enviada![Ô], RetVal)
End Sub


[txt-color=#e80000]função enviar[/txt-color]





Public Function SendMail(sTo As String, sSubject As String, sFrom As String, _
sBody As String, sSmtpServer As String, iSmtpPort As Integer, _
sSmtpUser As String, sSmtpPword As String, _
sFilePath As String, bSmtpSSL As Boolean) As String

On Error GoTo SendMail_Error:
Dim lobj_cdomsg As cdo.Message
Set lobj_cdomsg = New cdo.Message
lobj_cdomsg.Configuration.Fields(cdoSMTPServer) = sSmtpServer
lobj_cdomsg.Configuration.Fields(cdoSMTPServerPort) = iSmtpPort
lobj_cdomsg.Configuration.Fields(cdoSMTPUseSSL) = bSmtpSSL
lobj_cdomsg.Configuration.Fields(cdoSMTPAuthenticate) = cdoBasic
lobj_cdomsg.Configuration.Fields(cdoSendUserName) = sSmtpUser
lobj_cdomsg.Configuration.Fields(cdoSendPassword) = sSmtpPword
lobj_cdomsg.Configuration.Fields(cdoSMTPConnectionTimeout) = 30
lobj_cdomsg.Configuration.Fields(cdoSendUsingMethod) = cdoSendUsingPort
lobj_cdomsg.Configuration.Fields.Update
lobj_cdomsg.To = sTo
lobj_cdomsg.from = sFrom
lobj_cdomsg.Subject = sSubject

If Option1.Value = True Then
lobj_cdomsg.HTMLBody = sBody
Else
lobj_cdomsg.TextBody = sBody
End If








If lstAnexos.ListCount = 0 Then

Else
lstAnexos.ListIndex = lstAnexos.TopIndex
Dim l As Long
For l = 0 To lstAnexos.ListCount - 1
lobj_cdomsg.AddAttachment lstAnexos.list(l)
Next l
End If








lobj_cdomsg.sEnd
Set lobj_cdomsg = Nothing
SendMail = [Ô]ok[Ô]
Exit Function

SendMail_Error:
SendMail = Err.description
[ô]
End Function


[txt-color=#e80000]configurações de porta e servidores [/txt-color]


If Combo1.Text = [Ô]Yahoo[Ô] Then
txtServer.Text = [Ô]smtp.mail.yahoo.com[Ô]
Text2.Text = [Ô]465[Ô]
End If


If Combo1.Text = [Ô]Localweb[Ô] Then
txtServer.Text = [Ô]email-ssl.com.br[Ô]
Text2.Text = [Ô]465[Ô]

End If



If Combo1.Text = [Ô]Gmail[Ô] Then
txtServer.Text = [Ô]smtp.gmail.com[Ô]
Text2.Text = [Ô]465[Ô]

End If



If Combo1.Text = [Ô]Bol[Ô] Then
txtServer.Text = [Ô]smtps.bol.com.br[Ô]
Text2.Text = [Ô]465[Ô]

End If




If Combo1.Text = [Ô]Bol[Ô] Then
txtServer.Text = [Ô]smtps.bol.com.br[Ô]
Text2.Text = [Ô]465[Ô]

End If




If Combo1.Text = [Ô]Hotmail[Ô] Then
Text2.Text = [Ô]25[Ô]

End If

[txt-color=#e80000]Finalize o tópico quando terminado[/txt-color]
JCM0867 18/08/2016 11:45:28
#465937
Eu tenho uma solução pronta,
Só que é em VB.NET. Um diferencial que ele pode colocar imagem de cabeçalho e Rodapé.
http://www.vbmania.com.br/index.php?modulo=detalhe&id=9477





[txt-color=#0000f0]Precisando de um Sistema de Gestão Educacional?[/txt-color]
Desenvolvido em VB.NET + SQL Server + Crystal Reports
Conheça nossa Solução: www.cjsystem.com.br
MILTONSILVA94 18/08/2016 13:11:04
#465942
Porquê ocorre este erro?
FABRICIOWEB 18/08/2016 13:27:10
#465943
Substitua por isso

RetVal = SendMail(Trim$(txtTo.Text), _
Trim$(txtSubject.Text), _
Trim$(txtFromName.Text) & [Ô]<[Ô] & Trim$(txtFromEmail.Text) & [Ô]>[Ô], _
Trim$(txtMsg.Text), _
Trim$(txtServer.Text), _
CInt(Trim$(txtPort.Text)), _
Trim$(txtUsername.Text), _
Trim$(txtPassword.Text), _
lstAnexos, _
CBool(chkSSL.Value))
cmdSend.Enabled = True
msgbox IIf(RetVal = [Ô]ok[Ô], [Ô]Menssagem Enviada![Ô], RetVal)
End Sub
MILTONSILVA94 18/08/2016 14:05:03
#465946
Citação:

:
Substitua por isso

RetVal = SendMail(Trim$(txtTo.Text), _
Trim$(txtSubject.Text), _
Trim$(txtFromName.Text) & [Ô]<[Ô] & Trim$(txtFromEmail.Text) & [Ô]>[Ô], _
Trim$(txtMsg.Text), _
Trim$(txtServer.Text), _
CInt(Trim$(txtPort.Text)), _
Trim$(txtUsername.Text), _
Trim$(txtPassword.Text), _
lstAnexos, _
CBool(chkSSL.Value))
cmdSend.Enabled = True
msgbox IIf(RetVal = [Ô]ok[Ô], [Ô]Menssagem Enviada![Ô], RetVal)
End Sub



Achei que o comentário não ia dar problema

Irei testar!
MILTONSILVA94 18/08/2016 19:13:26
#465960
Fabricio, gostaria de entender alguns campos que estão neste código:

txtattach [ô]Para que serve este campo que está no código??
txtServer [ô]Se meu destinatário é [ô]hotmail[ô] qual valor coloco neste campo
txtUsername [ô]Toda vez que alguém for enviar algum email deverá informar o login do seu email?
txtPassword [ô]Toda vez que alguém for enviar algum email deverá informar a senha do seu email?
Text2 [ô]Para que serve este campo que está no código?
chkSSL [ô]Para que serve este campo que está no código?
lstAnexos [ô]Este campo é um ListBox?
FABRICIOWEB 18/08/2016 20:48:07
#465966
Se você não conseguir agora você nunca mais consegue!
A respeito do que você tem que colocar no server já falei nas primeiras respostas é só você ler!
E se o programa é de uso pessoal você pode deixar seus dados salvos se não crie um INI.
A respeito do que é um SSL SEGUE O LINK.
http://www.tecmundo.com.br/seguranca/1896-o-que-e-ssl-.htm
MILTONSILVA94 01/11/2016 23:52:10
#468686
Reativei o tópico pois o exemplo também não funcionou para mim.
Ocorre erro quando clico em enviar. Tem muitas informações neste código? Desta maneira como está, precisa configurar alguma coisa no office? Algum sugestão ou forma para corrigir esse problema?

--Código

Option Explicit
Dim x As Long

Private Sub Command1_Click()

If x - 1 < 0 Then
Else
x = x - 1
MAPIMessages1.MsgIndex = x
Text1.Text = MAPIMessages1.RecipDisplayName
Text2.Text = MAPIMessages1.MsgSubject
Text3.Text = MAPIMessages1.MsgOrigDisplayName
Text4.Text = MAPIMessages1.MsgNoteText
End If

End Sub

Private Sub Command2_Click()

If x + 1 > MAPIMessages1.MsgCount Then
x = MAPIMessages1.MsgCount
Else
x = x + 1
MAPIMessages1.MsgIndex = x
Text1.Text = MAPIMessages1.RecipDisplayName
Text2.Text = MAPIMessages1.MsgSubject
Text3.Text = MAPIMessages1.MsgOrigDisplayName
Text4.Text = MAPIMessages1.MsgNoteText
End If

End Sub

Private Sub Command3_Click()
MAPISession1.SignOn
MAPIMessages1.SessionID = MAPISession1.SessionID
MAPIMessages1.Fetch
If MAPIMessages1.MsgCount > 0 Then
Text1.Text = MAPIMessages1.RecipDisplayName
Text2.Text = MAPIMessages1.MsgSubject
Text3.Text = MAPIMessages1.MsgOrigDisplayName
Text4.Text = MAPIMessages1.MsgNoteText
Command4.Enabled = True
Else
MsgBox [Ô]No messages to fetch[Ô]
MAPISession1.SignOff
Command4.Enabled = False
End If

End Sub

Private Sub Command4_Click()

MAPIMessages1.Compose
MAPIMessages1.RecipDisplayName = Text1.Text
MAPIMessages1.MsgSubject = Text2.Text
MAPIMessages1.MsgNoteText = Text4.Text
MAPIMessages1.ResolveName
MAPIMessages1.send

End Sub

Private Sub Command5_Click()

MAPISession1.SignOff
Unload Me

End Sub

Private Sub Form_Load()
Label1.Caption = [Ô]To:[Ô]
Label2.Caption = [Ô]SUBJECT:[Ô]
Label3.Caption = [Ô]FROM:[Ô]
Label4.Caption = [Ô]MESSAGE:[Ô]

Command1.Caption = [Ô]<<[Ô]
Command2.Caption = [Ô]>>[Ô]
Command3.Caption = [Ô]Connect[Ô]
Command4.Caption = [Ô]Send[Ô]
Command5.Caption = [Ô]Close Session[Ô]
End Sub
Página 1 de 2 [11 registro(s)]
Tópico encerrado , respostas não são mais permitidas
Voltar