Srs, Eu preciso varrer minha Database chamada "Dados de Equipamentos" e mandar um Lotus Notes para todos que tiverem equipamentos em atraso. Eu criei o Seguinte código: Option Compare Database
'Enviar email
Sub Enviar_email(ByVal lEndereco As String, ByVal lEquip As String)
Dim Maildb As Object
Dim MailDoc As Object
Dim Body As Object
Dim Session As Object
Set Session = CreateObject("Lotus.NotesSession")
Call Session.Initialize
Set Maildb = Session.GETDATABASE("", "c:\notes\data\mail\mymail.nsf")
If Not Maildb.IsOpen = True Then
Call Maildb.Open
End If
'Create the mail document
Set MailDoc = Maildb.CREATEDOCUMENT
Call MailDoc.ReplaceItemValue("Form", "Memo")
'Set the recipient
Call MailDoc.ReplaceItemValue("SendTo", lEndereco)
'Set subject
Call MailDoc.ReplaceItemValue("Subject", "Equipamento em Atraso")
Set Body = MailDoc.CREATERICHTEXTITEM("A Devolução do Equipamento " & lEquip & " está em atraso, por favor verifique.")
Call Body.APPENDTEXT("Body text here")
MailDoc.SAVEMESSAGEONSEND = True
Call MailDoc.ReplaceItemValue("PostedDate", Now())
Call MailDoc.SEND(False)
Set Maildb = Nothing
Set MailDoc = Nothing
Set Body = Nothing
Set Session = Nothing
End Sub
'Enviar emails das pendências
Sub lsEnviarAtrasos()
Dim iTotalLinhas As Long
Dim i As Long
Dim lHoje As Date
Me.Select
Cells(1, 1).Select
iTotalLinhas = Cells(Rows.Count, 1).End(xlUp).Row
i = 1
While i <= iTotalLinhas
If Cells(i, 6).Value <= Data() Then
Enviar_email Cells(i, 12).Value, Cells(i, 2).Value
End If
i = i + 1
Wend
End Sub
'Enviar emails e fechar aplicação
Sub lsValidaEnvio()
If MsgBox("Deseja verificar as pendências e enviar por email?", vbYesNo, "5W2H") = vbYes Then
lsEnviarAtrasos
End If
End Sub O problema é que não consigo criar o método "lsEnviarAtrasos()", pois não consigo varrer a Database. Como posso fazer isso? Sendo que o destinatario esta na 16ª Coluna e o Nome do Equipamento está na 2ª Coluna.
