HOLA TENGO EL SIGUIENTE CODIGO, QUIERO ENVIAR CORREOS A LOS USUARIOS Q FALTAN DE MANDAR 1 REPORTE MENSUAL. MI PROBLEMA ES QUE ME MANDA ERROR 424---- SE REQUIERE UN OBJETO... YA NO TENGO IDEA DE COMO RESOLVERLO..... HACE TODO LO Q LE PIDO, SOLO Q CUANDO ESCOJO AL USUARIO Y ENVIO EL MENSAJE ME MANDA ESE ERROR
Private Sub btn_send_Click()
Dim strMail As String
Dim strBuffer As String
Dim iRetWrite As Long
strMail = ""
If AdminTool.rd_comppending.Value = True Then
For i = 1 To lst_signatures.ListItems.count
strMail = strMail & lst_signatures.ListItems.Item(i) & "@dfdff.dfdf, "
Next i
strMail = Left(strMail, Len(strMail) - 2)
Else
Set rst = New ADODB.Recordset
strSQL = " SELECT signature " & _
" FROM appusr_profile, department " & _
" WHERE department.name = '" & Tool.txt_trpdept.Text & "' " & _
" AND appr_dept_id = department.id " & _
" AND isDrag = 1"
rst.Open strSQL, de_TimeDB.cnn_TimeDB, adOpenStatic, adLockReadOnly, adCmdText
Do While Not rst.EOF
strMail = Trim(rst!signature) & "@dfdfdf.dfdf"
rst.MoveNext
Loop
'clean up
rst.Close
Set rst = Nothing
End If
On Error GoTo ErrorHandler
'Preparar Mail
MailMessage1.action = 8
MailMessage1.To = strMail
MailMessage1.From = "[email protected]" 'cuenta
MailMessage1.Text = Trim(Tool.txt_trpmessage.Text)
MailMessage1.Date = Format(Now, "yyyymmddhhmmss")
MailMessage1.Subject = Trim(Tool.txt_trpsubject.Text) & " Week: " & Trim(Tool.txt_trpweek.Text)
'Mandar mensaje
SmtpClient1.AutoResolve = True
SmtpClient1.Blocking = True
SmtpClient1.HostName = "aaaaa.dfdfd.dfdf"
If SmtpClient1.Connect() <> 0 Then
MsgBox "Connecting to SMTP server failure"
SmtpClient1.LastError = 0
Exit Sub
End If
'Identify ourselves to the server
SmtpClient1.Address = "[email protected]"
If SmtpClient1.AddressMail <> 0 Then
MsgBox "No source address was specified"
SmtpClient1.LastError = 0
Exit Sub
End If
' Send recipient addresses to the server
SmtpClient1.Recipient = strMail
If SmtpClient1.Recipient = "" Then
MsgBox "No destiny address was specified"
SmtpClient1.LastError = 0
Exit Sub
End If
strBuffer = ""
Clipboard.clear
If MailMessage1.ExportFile(strBuffer) <> 0 Then
MsgBox "Exporting file failure"
MailMessage1.LastError = 0
Exit Sub
End If
strBuffer = Clipboard.GetText
Clipboard.clear
While Len(strBuffer) > 0
iRetWrite = SmtpClient1.Write(strBuffer, 2048)
If iRetWrite < 0 Then
MsgBox "Error while writing to SMTP server " & SmtpClient1.LastError
SmtpClient1.LastError = 0
Exit Sub
End If
strBuffer = Right(strBuffer, Len(strBuffer) - iRetWrite)
Wend
SmtpClient1.SendMail
MsgBox "E-mail message has been succesfully sent", vbInformation
SmtpClient1.Disconnect
RReport.Hide
Unload RReport
Exit Sub
ErrorHandler:
If Err <> 0 Then
MsgBox Err.Number & "-->" & Err.Description, , "Error"
End If
End Sub
GRACIAS
