Olá,
Consegui adaptar o código abaixo para uma aplicação que tenho. No entanto, também gostaria de após encontrar o último e-mail enviado copiar intervalo que tenho no excel (A2:F40) no corpo do e-mail e após o envio do e-mail, e-mail em uma pasta específica para fora do Outlook (tenho o nome da pasta e do arquivo em um intervalo no excel (A41:A42). Se Puderem me ajudar com o código...
Meu Script (VBA):
Sub Encaminhar_No_Movements()
' Outlook's constant
Const olFolderSentMail = 5
' Variables
Dim OutlookApp As Object
Dim IsOutlookCreated As Boolean
Dim sFilter As String, sSubject As String
' Get/create outlook object
On Error Resume Next
Set OutlookApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlookApp = CreateObject("Outlook.Application")
IsOutlookCreated = True
End If
On Error GoTo 0
' Restrict items
sSubject = ActiveCell.Value
sFilter = "[Subject] = '" & sSubject & "'"
' Main
With OutlookApp.Session.GetDefaultFolder(olFolderSentMail).Items.Restrict(sFilter)
If .Count > 0 Then
.Sort "ReceivedTime", True
'With .Item(1).ReplyAll
With .Item(1).Forward
.To = Worksheets("Planilha3").Range("C10")
'.Recipients.Add "[email protected]"
.Display
'.Send
End With
Else
MsgBox "No emails found with Subject:" & vbLf & "'" & sSubject & "'"
End If
End With
' Quit Outlook instance if it was created by this code
If IsOutlookCreated Then
OutlookApp.Quit
Set OutlookApp = Nothing
End If
End Sub
Postado : 25/07/2022 8:32 am