ENVIAR E-MAIL COM ANEXO
Olá.. pessoal, pequei esse projeto aqui no forum.. estou testando com e-mail[ô]s de origem e destinatários vários, mas nao funiona.. o que pode está de errado... ????
Option Explicit
Option Compare Text
Private WithEvents poSendMail As vbSendMail.clsSendMail
Private bSendFailed As Boolean
[ô]Login
Dim bAuthLogin As Boolean
Private Sub ckLogin_Click()
If ckLogin.Value = vbChecked Then
bAuthLogin = True
txtUserName.Enabled = True
txtPassword.Enabled = True
Else
bAuthLogin = False
txtUserName.Enabled = False
txtPassword.Enabled = False
txtUserName.Text = [Ô][Ô]
txtPassword.Text = [Ô][Ô]
End If
End Sub
Private Sub cmdSend_Click()
Dim lCount As Long
Dim lCtr As Long
Dim t!
cmdSend.Enabled = False
bSendFailed = False
lstStatus.Clear
lblTime.Caption = [Ô][Ô]
Screen.MousePointer = vbHourglass
With poSendMail
[ô] **************************************************************************
[ô] Set the basic properties common to all messages to be sent
[ô] **************************************************************************
.SMTPHost = txtServer.Text [ô] Required the fist time, optional thereafter
.From = txtFrom.Text [ô] Required the fist time, optional thereafter
.FromDisplayName = txtFromName.Text [ô] Optional, saved after first use
.Message = txtMsg.Text [ô] Optional
.Attachment = Trim(txtAttach.Text) [ô] Optional, separate multiple entries with delimiter character
.UseAuthentication = bAuthLogin [ô] Optional, default = FALSE
.Username = txtUserName.Text [ô] Optional, default = Null String
.Password = txtPassword.Text [ô] Optional, default = Null String, value is NOT saved
[ô] get the message count and set the timer
lCount = Val(txtQty)
If lCount = 0 Then Exit Sub
t! = Timer
[ô] **************************************************************************
[ô] Send the mail in a loop. In a real app you would need to load a new
[ô] recipient from a file or database each pass through the loop.
[ô] **************************************************************************
If optSend(0).Value = True Then
[ô] send method only (normal button)
For lCtr = 1 To lCount
.Recipient = txtTo.Text
.RecipientDisplayName = txtToName.Text
.Subject = txtSubject
lblTime = [Ô]Enviar mensagem [Ô] & Str(lCtr)
.Send
Next
Else
[ô] connect, send, & disconnect methods (bulk send button)
If .Connect Then
For lCtr = 1 To lCount
lblTime = [Ô]Sending message [Ô] & Str(lCtr)
.Recipient = txtTo.Text
.RecipientDisplayName = txtToName.Text
.Subject = txtSubject
.Send
Next
.Disconnect
End If
End If
End With
[ô] display the results
If Not bSendFailed Then lblTime.Caption = Str(lCount) & [Ô] Mensagens enviadas em [Ô] & Format$(Timer - t!, [Ô]#,##0.0[Ô]) & [Ô] segundos.[Ô]
Screen.MousePointer = vbDefault
cmdSend.Enabled = True
End Sub
[ô] *****************************************************************************
[ô] The following four Subs capture the Events fired by the vbSendMail component
[ô] *****************************************************************************
Private Sub poSendMail_Progress(lPercentCompete As Long)
[ô] vbSendMail [ô]Progress Event[ô]
lblProgress = lPercentCompete & [Ô]% Completado[Ô]
End Sub
Private Sub poSendMail_SendFailed(Explanation As String)
[ô] vbSendMail [ô]SendFailed Event[ô]
MsgBox ([Ô]Sua tentativa de enviar e-mail falhou pelo seguinte motivo(s): [Ô] & vbCrLf & Explanation)
bSendFailed = True
lblProgress = [Ô][Ô]
lblTime = [Ô][Ô]
End Sub
Private Sub poSendMail_SendSuccesful()
[ô] vbSendMail [ô]SendSuccesful Event[ô]
lblProgress = [Ô]Enviado com Sucesso![Ô]
End Sub
Private Sub poSendMail_Status(Status As String)
[ô] vbSendMail [ô]Status Event[ô]
lstStatus.AddItem Status
lstStatus.ListIndex = lstStatus.ListCount - 1
lstStatus.ListIndex = -1
End Sub
Private Sub Form_Load()
Set poSendMail = New clsSendMail
With Me
.Move (Screen.Width - .Width) / 2, (Screen.Height - .Height) / 2
.lblProgress = [Ô][Ô]
.lblTime = [Ô][Ô]
.Show
.Refresh
End With
With poSendMail
.SMTPHostValidation = VALIDATE_HOST_DNS
.EmailAddressValidation = VALIDATE_SYNTAX
.Delimiter = [Ô];[Ô]
End With
cmDialog.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set poSendMail = Nothing
End Sub
Private Sub cmdBrowse_Click()
cmDialog.ShowOpen
If txtAttach.Text = [Ô][Ô] Then
txtAttach.Text = cmDialog.FileName
Else
txtAttach.Text = txtAttach.Text & [Ô];[Ô] & cmDialog.FileName
End If
End Sub
Private Sub cmdExit_Click()
Dim frm As Form
For Each frm In Forms
Unload frm
Set frm = Nothing
Next
End
End Sub
Private Sub cmdReset_Click()
ClearTextBoxesOnForm
lstStatus.Clear
lblProgress = [Ô][Ô]
lblTime = [Ô][Ô]
End Sub
Public Sub ClearTextBoxesOnForm()
[ô] Snippet Taken From http://www.freevbcode.com
Dim ctl As Control
For Each ctl In Me.Controls
If TypeOf ctl Is TextBox Then
ctl.Text = [Ô][Ô]
End If
Next
End Sub
Private Sub txtQty_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 48 To 57 [ô] numeric
Case 8 [ô] backspace
Case Else: KeyAscii = 0
End Select
End Sub
Option Explicit
Option Compare Text
Private WithEvents poSendMail As vbSendMail.clsSendMail
Private bSendFailed As Boolean
[ô]Login
Dim bAuthLogin As Boolean
Private Sub ckLogin_Click()
If ckLogin.Value = vbChecked Then
bAuthLogin = True
txtUserName.Enabled = True
txtPassword.Enabled = True
Else
bAuthLogin = False
txtUserName.Enabled = False
txtPassword.Enabled = False
txtUserName.Text = [Ô][Ô]
txtPassword.Text = [Ô][Ô]
End If
End Sub
Private Sub cmdSend_Click()
Dim lCount As Long
Dim lCtr As Long
Dim t!
cmdSend.Enabled = False
bSendFailed = False
lstStatus.Clear
lblTime.Caption = [Ô][Ô]
Screen.MousePointer = vbHourglass
With poSendMail
[ô] **************************************************************************
[ô] Set the basic properties common to all messages to be sent
[ô] **************************************************************************
.SMTPHost = txtServer.Text [ô] Required the fist time, optional thereafter
.From = txtFrom.Text [ô] Required the fist time, optional thereafter
.FromDisplayName = txtFromName.Text [ô] Optional, saved after first use
.Message = txtMsg.Text [ô] Optional
.Attachment = Trim(txtAttach.Text) [ô] Optional, separate multiple entries with delimiter character
.UseAuthentication = bAuthLogin [ô] Optional, default = FALSE
.Username = txtUserName.Text [ô] Optional, default = Null String
.Password = txtPassword.Text [ô] Optional, default = Null String, value is NOT saved
[ô] get the message count and set the timer
lCount = Val(txtQty)
If lCount = 0 Then Exit Sub
t! = Timer
[ô] **************************************************************************
[ô] Send the mail in a loop. In a real app you would need to load a new
[ô] recipient from a file or database each pass through the loop.
[ô] **************************************************************************
If optSend(0).Value = True Then
[ô] send method only (normal button)
For lCtr = 1 To lCount
.Recipient = txtTo.Text
.RecipientDisplayName = txtToName.Text
.Subject = txtSubject
lblTime = [Ô]Enviar mensagem [Ô] & Str(lCtr)
.Send
Next
Else
[ô] connect, send, & disconnect methods (bulk send button)
If .Connect Then
For lCtr = 1 To lCount
lblTime = [Ô]Sending message [Ô] & Str(lCtr)
.Recipient = txtTo.Text
.RecipientDisplayName = txtToName.Text
.Subject = txtSubject
.Send
Next
.Disconnect
End If
End If
End With
[ô] display the results
If Not bSendFailed Then lblTime.Caption = Str(lCount) & [Ô] Mensagens enviadas em [Ô] & Format$(Timer - t!, [Ô]#,##0.0[Ô]) & [Ô] segundos.[Ô]
Screen.MousePointer = vbDefault
cmdSend.Enabled = True
End Sub
[ô] *****************************************************************************
[ô] The following four Subs capture the Events fired by the vbSendMail component
[ô] *****************************************************************************
Private Sub poSendMail_Progress(lPercentCompete As Long)
[ô] vbSendMail [ô]Progress Event[ô]
lblProgress = lPercentCompete & [Ô]% Completado[Ô]
End Sub
Private Sub poSendMail_SendFailed(Explanation As String)
[ô] vbSendMail [ô]SendFailed Event[ô]
MsgBox ([Ô]Sua tentativa de enviar e-mail falhou pelo seguinte motivo(s): [Ô] & vbCrLf & Explanation)
bSendFailed = True
lblProgress = [Ô][Ô]
lblTime = [Ô][Ô]
End Sub
Private Sub poSendMail_SendSuccesful()
[ô] vbSendMail [ô]SendSuccesful Event[ô]
lblProgress = [Ô]Enviado com Sucesso![Ô]
End Sub
Private Sub poSendMail_Status(Status As String)
[ô] vbSendMail [ô]Status Event[ô]
lstStatus.AddItem Status
lstStatus.ListIndex = lstStatus.ListCount - 1
lstStatus.ListIndex = -1
End Sub
Private Sub Form_Load()
Set poSendMail = New clsSendMail
With Me
.Move (Screen.Width - .Width) / 2, (Screen.Height - .Height) / 2
.lblProgress = [Ô][Ô]
.lblTime = [Ô][Ô]
.Show
.Refresh
End With
With poSendMail
.SMTPHostValidation = VALIDATE_HOST_DNS
.EmailAddressValidation = VALIDATE_SYNTAX
.Delimiter = [Ô];[Ô]
End With
cmDialog.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set poSendMail = Nothing
End Sub
Private Sub cmdBrowse_Click()
cmDialog.ShowOpen
If txtAttach.Text = [Ô][Ô] Then
txtAttach.Text = cmDialog.FileName
Else
txtAttach.Text = txtAttach.Text & [Ô];[Ô] & cmDialog.FileName
End If
End Sub
Private Sub cmdExit_Click()
Dim frm As Form
For Each frm In Forms
Unload frm
Set frm = Nothing
Next
End
End Sub
Private Sub cmdReset_Click()
ClearTextBoxesOnForm
lstStatus.Clear
lblProgress = [Ô][Ô]
lblTime = [Ô][Ô]
End Sub
Public Sub ClearTextBoxesOnForm()
[ô] Snippet Taken From http://www.freevbcode.com
Dim ctl As Control
For Each ctl In Me.Controls
If TypeOf ctl Is TextBox Then
ctl.Text = [Ô][Ô]
End If
Next
End Sub
Private Sub txtQty_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 48 To 57 [ô] numeric
Case 8 [ô] backspace
Case Else: KeyAscii = 0
End Select
End Sub
olá, pessoal, estou tentando enviar e-mail com anexo. já testei com email[ô]s validos, nao envia. alguma sugestão.. ??
ôpa.. alguem... ?
Quer algo amis prático???
Private Sub Command1_Click()
[ô]PRECISA INCLUIR NO PROJETO A DLL MICROSOFT CDO FOR WINDOWS 2000 LIBRARY (Projects - References - MICROSOFT CDO FOR WINDOWS 2000 LIBRARY )
Dim msg As CDO.Message
Dim Cof As CDO.Configuration
Dim Camp
Set msg = New CDO.Message
Set Cof = New CDO.Configuration
Set Camp = Cof.Fields
With Camp
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServerPort) = 587 [ô]Aqui vai a porta de saÃda
.Item(cdoSMTPServer) = [Ô]smtp.servidorsmtp.com.br[Ô] [ô]Servidor smtp
.Item(cdoSMTPConnectionTimeout) = 50 [ô] quick timeout
.Item(cdoSMTPAuthenticate) = 1
.Item(cdoSendUserName) = [Ô]seuemail@seuemail.com.br[Ô]
.Item(cdoSendPassword) = [Ô]senhasenha[Ô]
.Update
End With
DoEvents
With msg
Set .Configuration = Cof
.To = [Ô]destino@gmail.com[Ô] [ô] para vário desinatário, separar com vÃrgula
.From = [Ô]origem@gmail.com.br[Ô] [ô] quem está mandando
.Subject = [Ô]ARQUIVO XML[Ô]
.HTMLBody = [Ô]ARQUIVO XML PARA A CONTABILIDADE[Ô]
.CC = [Ô]cc@gmail.com.br[Ô] [ô]Informe o ou os destinatários da cópia[Ô]
.BCC = [Ô]bcc@gmail.com.br[Ô] [ô]Informe o ou os destinatários da cópia oculta
.AddAttachment [Ô]C:\ERP Versátil\event.log[Ô] [ô] Anexo
.Send
End With
DoEvents
MsgBox [Ô]EMAIL ENVIADO COM SUCESSO!!![Ô]
End Sub
Private Sub Command1_Click()
[ô]PRECISA INCLUIR NO PROJETO A DLL MICROSOFT CDO FOR WINDOWS 2000 LIBRARY (Projects - References - MICROSOFT CDO FOR WINDOWS 2000 LIBRARY )
Dim msg As CDO.Message
Dim Cof As CDO.Configuration
Dim Camp
Set msg = New CDO.Message
Set Cof = New CDO.Configuration
Set Camp = Cof.Fields
With Camp
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServerPort) = 587 [ô]Aqui vai a porta de saÃda
.Item(cdoSMTPServer) = [Ô]smtp.servidorsmtp.com.br[Ô] [ô]Servidor smtp
.Item(cdoSMTPConnectionTimeout) = 50 [ô] quick timeout
.Item(cdoSMTPAuthenticate) = 1
.Item(cdoSendUserName) = [Ô]seuemail@seuemail.com.br[Ô]
.Item(cdoSendPassword) = [Ô]senhasenha[Ô]
.Update
End With
DoEvents
With msg
Set .Configuration = Cof
.To = [Ô]destino@gmail.com[Ô] [ô] para vário desinatário, separar com vÃrgula
.From = [Ô]origem@gmail.com.br[Ô] [ô] quem está mandando
.Subject = [Ô]ARQUIVO XML[Ô]
.HTMLBody = [Ô]ARQUIVO XML PARA A CONTABILIDADE[Ô]
.CC = [Ô]cc@gmail.com.br[Ô] [ô]Informe o ou os destinatários da cópia[Ô]
.BCC = [Ô]bcc@gmail.com.br[Ô] [ô]Informe o ou os destinatários da cópia oculta
.AddAttachment [Ô]C:\ERP Versátil\event.log[Ô] [ô] Anexo
.Send
End With
DoEvents
MsgBox [Ô]EMAIL ENVIADO COM SUCESSO!!![Ô]
End Sub
perfeito, JONESPARIS.. irei adapitar minhas necessidades. obrigado....
Tópico encerrado , respostas não são mais permitidas