VB - Emails , emails , emails...


Quer enviar emails usando o VB ? Olha , eu já abordei (de leve) este assunto no artigo : Criando e Enviando E-mails com o Visual Basic. Neste artigo eu mostrava como fazer o serviço usando os objetos MAPI ; embora simples o método tem lá suas limitações.

Eu recebo diversos emails fazendo a mesma pergunta : Como enviar e-mails usando o VB ? Resolvi então escrever este artigo para mostrar outras possibilidades de como realizar esta tarefa tão em voga atualmente... Com certeza eu não irei esgotar o assunto , nem pretendo , espero apenas oferecer outras opções que possam ajudar a todos...

Usando componente de terceiros

Podemos enviar emails usando o VB com a ajuda de componentes de terceiros que foram desenvolvidos para realizar especificamente esta tarefa. Existem centenas de componentes que podemos usar para este fim , mas eu vou focar apenas : ASPMAIL (os demais são idênticos...), por um motivo , é simples e barato . Vamos a ele:

-Usando o ASPMAIL

O ASPMAIL é um componente muito conhecido para enviar email , voce pode fazer o download de cópia funcional no site http://www.serverobjects.com

A funcionalidade do componente esta na dll - smtpsvg.dll - após fazer o download você deve registrar o arquivo no seu sistema. Pode fazer isto usando o arquivo - regsvr32.exe - que vem junto com o pacote. Ex: regsvr32 smtpsvg.dll

Junto com o pacote de você encontra a documentação e exemplos de como usar o componente. A seguir vou mostrar um projeto prático feito em Visual Basic que usa o componente. Geralmente ele é usado em páginas ASP.

- Inicie um novo projeto no VB e no formulário padrão insira : 2 controles Frames , 6 controles Labels , 6 controles TextBox e dois botões de comando , conforme layout abaixo:

- A seguir no seu projeto , faça referência ao componente - SMTPsvg Library

- No evento click do botão de comando - Enviar Email - insira o seguinte código :

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 = "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

Nota: Você vai ter que usar um serviço SMTP de um servidor. Você pode até usar este serviço de alguns servidores na web ( embora eu ache um tanto deselegante fazer isto..). Além disto vai precisar estar conectado.

Enviando vários Emails

Muito simples , não é mesmo ??? Agora vou fazer uma pergunta : E se você precisar enviar emails para um grupo de pessoas ???

Elementar meu caro Watson !!! Vamos supor que você tenha um banco de dados com os dados de seus clientes (vai precisar ter o email deles é claro !!!). Primeiro você deve filtrar os clientes para os quais deseja enviar o email e a seguir percorre o recordset criado , gerando um email para cada cliente. Vou mostrar...

- Você tem um banco de dados chamado cadastro.mdb que contém a tabela clientes com os dados de todos os seus clientes.

- Você quer enviar emails para todos os clientes do sexo feminino.

- Com base nisto você deve montar uma instrução SQL para filtrar os clientes pelo sexo :

SELECT * FROM clientes WHERE sexo = 'F'

- Agora basta fazer a conexão com o banco de dados , filtrar os registros e usando o componente ASPMAIL ou qualquer outro de sua escolha enviar os emails. Com o ASPMAIL fariamos assim :

- Inicie um novo projeto no VB e no formulário padrão insira um botão de comando - command1 e a seguir o seguinte código:

Obs: Não esqueça de fazer uma referência a biblioteca ADO.

- Na seção General Declarations do formulário - form1 : declare as variáveis objeto que serão visíveis em todo o formulário.

Dim ConClientes As ADODB.Connection
Dim rsClientes As ADODB.Recordset

- No evento Load do formulário insira o código que abre o banco de dados e cria o recordset :

Private Sub Form_Load()
Dim strsql As String
Set ConClientes = New ADODB.Connection
Set rsClientes = New ADODB.Recordset

With ConClientes
  .Provider = "Microsoft.Jet.OLEDB.4.0"
  .ConnectionString = "Data Source=" & App.Path & "\Cadastro.mdb"
  .Open
End With

strsql = "SELECT Nome , Email FROM Clientes WHERE Sexo='F'"
rsClientes.Open strsql, ConClientes, adOpenForwardOnly, adLockReadOnly, adCmdText

End Sub

- Crie a procedure - Desconecta_BD - com o seguinte código :

Private Sub Desconecta_BD()
  rsClientes.Close
  Set rsClientes = Nothing
  ConClientes.Close
  Set ConClientes = Nothing
End Sub

- Agora no evento Click do botão de comando - command1 - insira o código que irá gerar os emails para cada cliente:

Private Sub Command1_Click()
Dim sucesso As Boolean
Dim total_emails As Integer

If rsClientes.recordcount > 0 Then

    While Not rsClientes

      Set EnviaEmail = CreateObject("SMTPsvg.Mailer")
      EnviaEmail.RemoteHost = "smtp.seuservidor.com.br"
      EnviaEmail.FromName = "Macoratti"
      EnviaEmail.FromAddress = "remetente@yahoo.com"
      EnviaEmail.AddRecipient rsClientes("nome"), rsClientes("email")
      EnviaEmail.Subject = "assunto"
      EnviaEmail.Bodytext = "Ola " & rsClientes("nome") & "," & Chr(13) & " seu texto"
      sucesso = EnviaEmail.SendMail

      rsClientes.movenext
      total_emails = total_emails + 1

    Wend
    MsgBox "Numero Total de Emails enviados : " & total_emails
Else
    MsgBox "Não há nenhum cliente para o critério informado !"
End If
Desconecta_BD

End Sub

Pronto ! Você acabou de enviar emails para um grupo de clientes pré-selecionados. Isto só foi uma amostra , você pode melhorar e adicionar funcionalidades ao exemplo acima. Fique a vontade...

Enviando email com o Winsock

Agora eu vou mostrar como você pode usar o componente Winsock para enviar emails. Eu não vou repetir aqui as propriedades/eventos do controle Winsock , para saber mais leia o artigo: VB6 - Usando o Controle Winsock.(Na tabela abaixo temos os principais métodos e eventos do controle Winsock)

Método/Evento Descrição
Accept Aceita uma conexão TCP. 
Connect Solicita uma conexão TCP. Ocorre quando há uma conexão com outro computador.
Close Fecha uma conexão TCP.
DataArrival Onde você coloca o código fonte que você deseja executar quando a informação chegar pela portal local.
GetData Efetua a recepção de dados
Listen Espera por uma conexão TCP.
SendData Envia dados.
SendProgress Indica que você quer controlar a conexão enquanto ela estiver enviando os dados. 
SendComplete Indica o que você quer que aconteça depois que a transferência foi terminada. Ex. Exibir uma mensagem.
ConnectionRequest Solicita uma conexão.
Error Ocorreu um erro.

Vamos criar uma aplicação VB que envie emails usando o componente Winsock. Ao trabalho...

- Inicie um novo projeto no VB no formulário padrão monte o layout conforme figura abaix:

- O formulário contém :

1 control Winsock - chamado smtp

1 controle combobox

8 caixas de textos

3 frames

4 controles images

11 controles labels

Para fazer a coisa funcionar voce deve preencher os campos do destinatário e remetente , escolher um servidor smtp , definir a porta o IP e o nome do Host e preencher o campo Assunto; depois é só clicar no ícone do menu para enviar. Vamos ao código do projeto:

- Evento Load do formulário - frmvbemail - define o tamanho do formulário e carrega a combobox - cboservidorsmtp com o nome de alguns servidores (você precisa testar se todos permanecem ativos...)

Private Sub Form_Load()
Me.Height = 4125
Me.Width = 7440

cboservidorsmtp.AddItem "acad.bryant.edu"
cboservidorsmtp.AddItem "valley-internet.net"
cboservidorsmtp.AddItem "grove.ufl.edu"
cboservidorsmtp.AddItem "hacker.com"
cboservidorsmtp.AddItem "kroner.ucdavis.edu"
cboservidorsmtp.ListIndex = 0

End Sub

- Código do evento Click do controle - Image1 - : invoca a função - envia_email.

Private Sub Image1_Click()
  envia_email
End Sub

- O código da função envia_email : verifica se os dados foram preenchidos e usa o evento Connect do controle Winsock para realizar a conexão com o servidor e a porta informados.

Private Sub envia_email()
  
  If txtdestinatario.Text = "" Then
      MsgBox "Informe o nome do destinario", vbCritical, "Enviando Email"
      txtdestinatario.SetFocus
      Exit Sub
  End If
  If txtremetente.Text = "" Then
      MsgBox "Informe o nome do remetente", vbCritical, "Enviando Email"
      txtremetente.SetFocus
      Exit Sub
  End If
  If InStr(1, txtemaildestinatario, "@") = 0 Then
      MsgBox "O email do destinatário deve conter um caracter @", vbCritical, "Enviando Email"
      txtemaildestinatario.SetFocus
      Exit Sub
  End If
  If InStr(1, txtemailremetente, "@") = 0 Then
      MsgBox "O email do remetente deve conter um caractere @", vbCritical, "Enviando Email"
      txtemailremetente.SetFocus
      Exit Sub
  End If
    
  lblstatus = "Conectando ..."
  smtp.Connect cboservidorsmtp.Text, Val(txtporta)

End Sub

- O código do evento Connect do controle Winsock é o seguinte:

Private Sub smtp_Connect()

verifica_status

If Not Val(temp(0)) = 220 Then
  MsgBox "Ocorreu o seguinte erro no servidor : " & vbCrLf + resposta
Conexao False
End If

lblstatus.Caption = "Recebendo mensagem..."

stmp.sendata "Ola " & smtp.LocalHostName & vbCrLf
DoEvents

verifica_status
recebe_dados

If Not Val(temp(0)) = 250 Then
  MsgBox "Ocorreu o seguinte erro no servidor : " & vbCrLf + resposta
  Conexao False
End If

'envia email
smtp.sendata "Email de :<" & txtremetente.Text & ">" & vbCrLf
DoEvents

verifica_status
recebe_dados

If Not Val(temp(0)) = 250 Then
  MsgBox "Ocorreu o seguinte erro no servidor : " & vbCrLf + resposta
  Conexao False
End If

smtp.SendData "Para : <" & txtdestinatario.Text & vbCrLf
DoEvents

verifica_status
recebe_dados

If Not Val(temp(0)) = 250 Then
  MsgBox "Ocorreu o seguinte erro no servidor : " & vbCrLf + resposta
  Conexao False
End If

smtp.SendData "Dados " & vbCrLf
DoEvents

verifica_status
recebe_dados

If Not Val(temp(0)) = 354 Then
  MsgBox "Ocorreu o seguinte erro no servidor : " & vbCrLf + resposta
  Conexao False
End If

lblstatus.Caption = "Enviando Email..."

smtp.SendData "De : <" & txtremetente.Text & ">" & vbCrLf & _
                      "Para : " & txtdestinatario.Text * vbCrLf & _
                      "Mailer: JcmSoft" & vbCrLf & _
                      "Mime-Version: 1.0" & vbCrLf & _
                      "Content-Type:text/html" & "charset=us-ascii" & vbCrLf & vbCrLf & txtassunto

smtp.SendData vbCrLf & "." & vbCrLf
DoEvents

verifica_status
recebe_dados

If Not Val(temp(0)) = 250 Then
  MsgBox "Ocorreu o seguinte erro no servidor : " & vbCrLf + resposta
  Conexao False
End If

smt.SendData "QUIT"
MsgBox "Mensagem enviada com sucesso ", vbInformation, "Envia E-mail"
End Sub

- O evento DataArrival ocorre quando os dados são recebidos pelo controle.

Private Sub smtp_DataArrival(ByVal bytesTotal As Long)
Dim Dados As String

 smtp.GetData Dados, vbString
 inDaDos = inDaDos & Dados
 If strcmp(Right$(inDaDos, 2), vbCrLf) = 0 Then inder = True

End Sub

- Para tratar erros usamos o evento - Error.

Private Sub smtp_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)
If Not Number = sckSuccess Then
MsgBox Err.Description
Conexao = True
End If
End Sub

- Abaixo o código de duas funções auxiliares : verifica_status e recebe_dados.

Private Sub verifica_status()
'aguarda resposta
While Not inder
  If smtp.State = sckClosed Then Exit Sub
  DoEvents
Wend
End Sub
Private Sub recebe_dados()
  resposta = inDaDos
  inDaDos = ""
  inder = False
  temp = Split(resposta, " ")
End Sub

- O código associado ao botão de comando - Assunto >> - que exibe a caixa de texto para voce digitar o texto.

Private Sub cmdassunto_Click()
If cmdassunto.Caption = "&Assunto >>" Then
  Me.Height = 6285
  Me.Width = 7440
  cmdassunto.Caption = "&Assunto <<"
Else
  Me.Height = 4125
  Me.Width = 7440
  cmdassunto.Caption = "&Assunto >>"
End If
End Sub

- Por último o código da função - Conexao - que encerra a conexão conforme o parâmetro passado.

Private Sub Conexao(Erro As Boolean)
smtp.Close
End Sub

Obs: Eu testei o projeto em um Windows 2000 e funcionou bem , se houver problemas favor me avisar

guenta que vai continuar...só falta enviar email usando o CDONTS


 José Carlos Macoratti