Tengo que mandar correo a las personas que no tiene hecho un reporte, creo que me esta haciendo ruido MailMessage1 y el SmtpClient1 pero no puedo solucionarlo.
No he intentado reinstalar Visual Basic
Me aparece tambien 1 archivo .txt con lo siguiente:
Línea 19: la clase SmtpClientCtrl.SmtpClient del control SmtpClient1 no era una clase de control cargada.
Línea 37: la clase MailMessageCtrl.MailMessage del control MailMessage1 no era una clase de control cargada.
Línea 98: la clase ComctlLib.ListView del control lst_signatures no era una clase de control cargada.
En el formulario Rreport tengo el siguiente codigo:
' connection and recordset variables
Dim rst, rst1, rst2 As New ADODB.Recordset
Dim strSQL As String
Private Sub btn_cancel_Click()
RReport.Hide
Unload RReport
End Sub
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) & "@empresa.com.mx, "
Next i
strMail = Left(strMail, Len(strMail) - 2)
Else
Set rst = New ADODB.Recordset
strSQL = " SELECT signature " & _
" FROM appusr_profile, department " & _
" WHERE department.name = '" & AdminTool.txt_trpdept.Text & "' " & _
" AND appr_dept_id = department.id " & _
" AND isDrag = 1"
rst.Open strSQL, de_TimeReportDB.cnn_TimeReportDB, adOpenStatic, adLockReadOnly, adCmdText
Do While Not rst.EOF
strMail = Trim(rst!signature) & "@empresa.com.mx"
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]"
MailMessage1.Text = Trim(AdminTool.txt_trpmessage.Text)
MailMessage1.Date = Format(Now, "yyyymmddhhmmss")
MailMessage1.Subject = Trim(AdminTool.txt_trpsubject.Text) & " Week: " & Trim(AdminTool.txt_trpweek.Text)
'Mandar mensaje
SmtpClient1.AutoResolve = True
SmtpClient1.Blocking = True
SmtpClient1.HostName = "hola.empresa.com.mx"
SmtpClient1.RemotePort = 25
SmtpClient1.Timeout = 20
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.Source & "-->" & Err.Description, , "Error"
End If
End Sub
Private Sub Form_Load()
Dim clm As ColumnHeader
Dim itx As Object
Dim pending As Integer
txt_week.Text = AdminTool.txt_trpweek.Text
pending = 0
'limpiar lista de employees
lst_signatures.ColumnHeaders.clear
lst_signatures.ListItems.clear
lst_signatures.View = lvwReport
If AdminTool.rd_comppending.Value = True Then
strSQL = " SELECT distinct(signature), department.name dept " & _
" From personnel, Department " & _
" Where dept_id = Department.id " & _
" And department.name like '" & AdminTool.txt_trpdept.Text & "%' " & _
" And active = 1 " & _
" And signature not in ( SELECT distinct(signature) " & _
" From current_daily_entry, Department " & _
" Where user_dept_id = Department.id " & _
" And week_id = " & txt_week.Text & " " & _
" And department.name like '" & AdminTool.txt_trpdept.Text & "%' " & _
" And completed = 1 ) " & _
" ORDER BY signature "
Else
strSQL = " SELECT distinct(signature), department.name dept " & _
" FROM current_daily_entry, department " & _
" WHERE user_dept_id = department.id " & _
" AND week_id = " & txt_week.Text & " " & _
" And department.name like '" & AdminTool.txt_trpdept.Text & "%' " & _
" And ((completed = 1) and (approved = 0)) " & _
" ORDER BY signature "
End If
' Get Employee signature that have fill time report
Set rst = New ADODB.Recordset
rst.Open strSQL, de_TimeReportDB.cnn_TimeReportDB, adOpenStatic, adLockReadOnly, adCmdText
lst_signatures.ColumnHeaders.Add , , "Signature", lst_signatures.Width / 2
lst_signatures.ColumnHeaders.Add , , "Department", lst_signatures.Width / 2
Do While Not rst.EOF
pending = pending + 1
Set itx = lst_signatures.ListItems.Add(, , Trim(rst!signature))
itx.SubItems(1) = Trim(rst!dept)
rst.MoveNext
Loop
'clean up
rst.Close
Set rst = Nothing
txt_totalpending.Text = pending
End Sub