none
Outlook, alguem pode me ajudar? RRS feed

  • Pergunta

  •  

    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.

    segunda-feira, 20 de novembro de 2006 15:10