Enviar Emails quando estiver na Data Actual (VBA)
![Imagem](https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEijULYyBA0NSieOhFuZw2SHpz-FbZbGT2DNV4mSgq6O-A8RJsIkdAZgNlKnIcOuxjh5zmrUuf53pzjXbr_3yG5nbBS9O6mYn2_EiZasYDLtc3PbkVpBr7WjzRmOKgvJD9f7a_aLAhg9uDo/s400/_ZIP_EMAIL.png)
Pretende-se com este código que quando a Data de Envio for igual a data em que nos encontramos é enviado um email ao destinatário. O código pesquisa todos os registos e envia para cada email onde a condição da data for a data actual. VBA Code/Macro: Sub SendEmail() Dim ws As Worksheet Dim oApp As Object, MailApp As Object, SendMail As Object Dim strbody As String Dim deldate As Variant Dim email As Variant Dim i As Integer Set ws = Worksheets("sheet1") ws.Select 'Set numrows = number of rows of data. NumRows = Range("A2", Range("A2").End(xlDown)).Rows.Count ' Select cell A2 Range("A2").Select 'Get Delivery date lin = 2 col = 4 deldate = ws.Cells(lin, col).Value 'Get email lin = 2 col = 7 email = ws.Cells(lin, col).Value ' -1 because sheet have header For i = 1 To NumRows - 1 If deldate = Date Then 'Create Email Set MailApp = CreateObject("Outlook.Application") ...