ENVIO DE ARQUIVO POR E-MAIL
Pessoal, boa tarde!
Caros, alguém poderia me ajudar em uma rotina para envio de arquivo para um determinado e-mail cadastrado. é o seguinte, tenho um sisteminha para compactação de arquivos, onde os arquivo ficam armazenados em uma pasta ENVIO, gostaria de criar alguma função para enviar um determinado arquivo desta pasta para os e-mail cadastrado na rotina.
Desde já agradeço pelo ajudar. Abraço a todos.
Caros, alguém poderia me ajudar em uma rotina para envio de arquivo para um determinado e-mail cadastrado. é o seguinte, tenho um sisteminha para compactação de arquivos, onde os arquivo ficam armazenados em uma pasta ENVIO, gostaria de criar alguma função para enviar um determinado arquivo desta pasta para os e-mail cadastrado na rotina.
Desde já agradeço pelo ajudar. Abraço a todos.
Certo, e qual a sua dúvida? Rotinas de envio de e-mail, tem aos montes por aÃ. Aqui mesmo no VBMania tem umas 10
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
lobj_cdomsg.TextBody = sBody
If Trim$(sFilePath) <> vbNullString Then
lobj_cdomsg.AddAttachment (sFilePath) [ô] arquivos aqui
End If
lobj_cdomsg.Send
Set lobj_cdomsg = Nothing
SendMail = [Ô]ok[Ô]
Exit Function
SendMail_Error:
SendMail = Err.Description
End Function
[ô]-----------------------------
Private Sub CmdSend_Click()
On Error Resume Next
Dim RetVal As String
Dim objControl As Control
[ô]Validate first
For Each objControl In Me.Controls
If TypeOf objControl Is TextBox Then
If Trim$(objControl.Text) = vbNullString And LCase$(objControl.Name) <> [Ô]txtattach[Ô] Then
[ô] Label2.Caption = [Ô]Todos os campos são requeridos![Ô]
[ô] Exit Sub
End If
End If
Next
[ô]Send
[ô] Frame1.Enabled = False
Frame2.Enabled = False
cmdSend.Enabled = False
Label2.Caption = [Ô]Enviando...[Ô]
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), _
Trim$(txtAttach.Text), _
CBool(chkSSL.Value))
Frame1.Enabled = True
Frame2.Enabled = True
cmdSend.Enabled = True
Label2.Caption = IIf(RetVal = [Ô]ok[Ô], [Ô]Enviando sms![Ô], RetVal)
End Sub
Private Sub sendmail1_SendSuccesful()
MsgBox [Ô]Menssagem enviado corretamente[Ô], vbInformation, [Ô]Estado de envÃo[Ô]
lblProgress = [Ô][Ô]
End Sub
Private Sub sendmail1_Progress(lPercentCompete As Long)
[ô]Visualiza el porcentaje del progreso del envÃo en el Label
lblProgress = lPercentCompete & [Ô]% completado[Ô]
End Sub
Private Sub sendmail1_SendFailed(Explanation As String)
[ô]En caso de fallar el envÃo se dispara este evento con la descripción del error
MsgBox ([Ô]El envÃo del Email falló por las posibles razones:: [Ô] & vbCrLf & Explanation)
lblProgress = [Ô][Ô]
Screen.MousePointer = vbDefault
cmdSend.Enabled = True
End Sub
Private Sub sendmail1_Status(Status As String)
[ô]Visualiza el estado del envÃo
lstStatus.AddItem Status
lstStatus.ListIndex = lstStatus.ListCount - 1
lstStatus.ListIndex = -1
End Sub
[ô]Para los adjuntos
Private Sub cmdbrowse_Click()
Dim ArchivosAdj() As String
Dim i As Integer
On Local Error GoTo ErrSub
With CommonDialog1
.FileName = [Ô][Ô]
.CancelError = True
.Filter = [Ô]All Files (*.*)|*.*|HTML Files (*.htm;*.html;*.shtml)|*.htm;*.html;*.shtml|Images (*.bmp;*.jpg;*.gif)|*.bmp;*.jpg;*.gif[Ô]
.FilterIndex = 1
.DialogTitle = [Ô]Select File Attachment(s)[Ô]
.MaxFileSize = &H7FFF
.Flags = &H4 Or &H800 Or &H40000 Or &H200 Or &H80000
.ShowOpen
ArchivosAdj = Split(.FileName, vbNullChar)
End With
If UBound(ArchivosAdj) = 0 Then
If txtAttach.Text = [Ô][Ô] Then
txtAttach.Text = ArchivosAdj(0)
Else
txtAttach.Text = txtAttach.Text & [Ô];[Ô] & ArchivosAdj(0)
End If
ElseIf UBound(ArchivosAdj) > 0 Then
If Right$(ArchivosAdj(0), 1) <> [Ô]\[Ô] Then ArchivosAdj(0) = ArchivosAdj(0) & [Ô]\[Ô]
For i = 1 To UBound(ArchivosAdj)
If txtAttach.Text = [Ô][Ô] Then
txtAttach.Text = ArchivosAdj(0) & ArchivosAdj(i)
Else
txtAttach.Text = txtAttach.Text & [Ô];[Ô] & ArchivosAdj(0) & ArchivosAdj(i)
End If
Next
Else
Exit Sub
End If
Exit Sub
ErrSub:
MsgBox Err.Description, vbCritical, [Ô]Error[Ô]
End Sub
ve se vc consegue intender e a mesma que eu uso
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
lobj_cdomsg.TextBody = sBody
If Trim$(sFilePath) <> vbNullString Then
lobj_cdomsg.AddAttachment (sFilePath) [ô] arquivos aqui
End If
lobj_cdomsg.Send
Set lobj_cdomsg = Nothing
SendMail = [Ô]ok[Ô]
Exit Function
SendMail_Error:
SendMail = Err.Description
End Function
[ô]-----------------------------
Private Sub CmdSend_Click()
On Error Resume Next
Dim RetVal As String
Dim objControl As Control
[ô]Validate first
For Each objControl In Me.Controls
If TypeOf objControl Is TextBox Then
If Trim$(objControl.Text) = vbNullString And LCase$(objControl.Name) <> [Ô]txtattach[Ô] Then
[ô] Label2.Caption = [Ô]Todos os campos são requeridos![Ô]
[ô] Exit Sub
End If
End If
Next
[ô]Send
[ô] Frame1.Enabled = False
Frame2.Enabled = False
cmdSend.Enabled = False
Label2.Caption = [Ô]Enviando...[Ô]
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), _
Trim$(txtAttach.Text), _
CBool(chkSSL.Value))
Frame1.Enabled = True
Frame2.Enabled = True
cmdSend.Enabled = True
Label2.Caption = IIf(RetVal = [Ô]ok[Ô], [Ô]Enviando sms![Ô], RetVal)
End Sub
Private Sub sendmail1_SendSuccesful()
MsgBox [Ô]Menssagem enviado corretamente[Ô], vbInformation, [Ô]Estado de envÃo[Ô]
lblProgress = [Ô][Ô]
End Sub
Private Sub sendmail1_Progress(lPercentCompete As Long)
[ô]Visualiza el porcentaje del progreso del envÃo en el Label
lblProgress = lPercentCompete & [Ô]% completado[Ô]
End Sub
Private Sub sendmail1_SendFailed(Explanation As String)
[ô]En caso de fallar el envÃo se dispara este evento con la descripción del error
MsgBox ([Ô]El envÃo del Email falló por las posibles razones:: [Ô] & vbCrLf & Explanation)
lblProgress = [Ô][Ô]
Screen.MousePointer = vbDefault
cmdSend.Enabled = True
End Sub
Private Sub sendmail1_Status(Status As String)
[ô]Visualiza el estado del envÃo
lstStatus.AddItem Status
lstStatus.ListIndex = lstStatus.ListCount - 1
lstStatus.ListIndex = -1
End Sub
[ô]Para los adjuntos
Private Sub cmdbrowse_Click()
Dim ArchivosAdj() As String
Dim i As Integer
On Local Error GoTo ErrSub
With CommonDialog1
.FileName = [Ô][Ô]
.CancelError = True
.Filter = [Ô]All Files (*.*)|*.*|HTML Files (*.htm;*.html;*.shtml)|*.htm;*.html;*.shtml|Images (*.bmp;*.jpg;*.gif)|*.bmp;*.jpg;*.gif[Ô]
.FilterIndex = 1
.DialogTitle = [Ô]Select File Attachment(s)[Ô]
.MaxFileSize = &H7FFF
.Flags = &H4 Or &H800 Or &H40000 Or &H200 Or &H80000
.ShowOpen
ArchivosAdj = Split(.FileName, vbNullChar)
End With
If UBound(ArchivosAdj) = 0 Then
If txtAttach.Text = [Ô][Ô] Then
txtAttach.Text = ArchivosAdj(0)
Else
txtAttach.Text = txtAttach.Text & [Ô];[Ô] & ArchivosAdj(0)
End If
ElseIf UBound(ArchivosAdj) > 0 Then
If Right$(ArchivosAdj(0), 1) <> [Ô]\[Ô] Then ArchivosAdj(0) = ArchivosAdj(0) & [Ô]\[Ô]
For i = 1 To UBound(ArchivosAdj)
If txtAttach.Text = [Ô][Ô] Then
txtAttach.Text = ArchivosAdj(0) & ArchivosAdj(i)
Else
txtAttach.Text = txtAttach.Text & [Ô];[Ô] & ArchivosAdj(0) & ArchivosAdj(i)
End If
Next
Else
Exit Sub
End If
Exit Sub
ErrSub:
MsgBox Err.Description, vbCritical, [Ô]Error[Ô]
End Sub
ve se vc consegue intender e a mesma que eu uso
Caramba FABRICIOWEB, não é à toa que você tem várias dúvidas...
kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk
duvidas fazem parte de um aprendizado 100% garantido
na verdade funcionou então nem quis mais mexer para melhorar ...
duvidas fazem parte de um aprendizado 100% garantido
na verdade funcionou então nem quis mais mexer para melhorar ...
Boa tarde KERPLUNK, na verdade quero enviar um determinado arquivo com extensão .zip ou .rar para algum e-mail cadastrado na rotina, ou até mesmo um grupo de e-mail.
Abraço.
Abraço.
Se for pelo gmail esta aqui.
Caso resolva finalize o topico.
Caso resolva finalize o topico.
Olha, não sei se você reparou, mas no código postado pelo FABRICIO, já tem um meio de adicionar anexos;
Obrigado pelo exemplo Fabricio, me tira uma dúvida, precisa fazer alguma referencia para rodar seu exemplo.
referencia CDO
Quando abro o projeto pede uma DLL chamada FM20.DLL.
Tópico encerrado , respostas não são mais permitidas