Pessoal, beleza?
Seguinte, estou começando agora a mexer com VBA e estou mais perdido que cego em tiroteio.
Eu vou precisar que o outlook verifique em uma tabela no access se se aquele e-mail esta cadastrado, se tiver vou salvar o anexo em uma pasta especifica com endereço do e-mail, se não, vou encaminhar para uma outra pasta.
Eu pesquisei na NET e achei uma macro que salva o anexo, mas essa macro varre a pasta selecionada por e-mail não lido e salva o anexo do não lido...
Sub salvar()
Set oApp = New Outlook.Application
Set oNameSpace = oApp.GetNamespace("MAPI")
Set oFolder = oNameSpace.GetDefaultFolder(olFolderInbox).Folders.Item("Yahoo")
Set oMailItem = oFolder.Items
Set colFilteredItems = oMailItem.Restrict("[Unread] = True")
For Each oMailItem In colFilteredItems
With oMailItem
If oMailItem.Attachments.Count > 0 Then
For F = 1 To oMailItem.Attachments.Count
oMailItem.Attachments.Item.SaveAsFile "C:\Anexos\" & oMailItem.Attachments.Item.FileName
DoEvents
Next F
End If
End With
Next oMailItem
End Sub
Ja o outro que eu achei faz seleciona as extençoes pre-definidas e salva em outra pasta.
Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
Private Sub Application_Quit()
Set olInboxItems = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objAttFld As MAPIFolder
Dim objInbox As MAPIFolder
Dim objNS As NameSpace
Dim strAttFldName As String
Dim strProgExt As String
Dim arrExt() As String
Dim objAtt As Attachment
Dim intPos As Integer
Dim I As Integer
Dim strExt As String
' #### OPÇÕES UTILIZADOR ####
' nome da subpasta dentro da Inbox para guardar os anexos
strAttFldName = "Quarentena"
' lista de extensões que se pretende apanhar (devem ser separadas por virgula)
strProgExt = "exe, bat, com, vbs, vbe"
On Error Resume Next
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objAttFld = objInbox.Folders(strAttFldName)
If Item.Class = olMail Then
If objAttFld Is Nothing Then
' cria a pasta se fôr preciso
Set objAttFld = objInbox.Folders.Add(strAttFldName)
End If
If Not objAttFld Is Nothing Then
' converte a lista das extensões numa array
arrExt = Split(strProgExt, ",")
For Each objAtt In Item.Attachments
intPos = InStrRev(objAtt.FileName, ".")
If intPos > 0 Then
' verifica as extensões do anexo contra a array
strExt = LCase(Mid(objAtt.FileName, intPos + 1))
For I = LBound(arrExt) To UBound(arrExt)
If strExt = Trim(arrExt) Then
Item.Move objAttFld
Exit For
End If
Next
Else
' se não há extensões; tipo desconhecido
Item.Move objAttFld
End If
Next
End If
End If
On Error GoTo 0
Set objAttFld = Nothing
Set objInbox = Nothing
Set objNS = Nothing
Set objAtt = Nothing
End Sub
Alguem pode me ajudar com isso ou pelo menos com uma apostila de VBA?
Agradeço.
