Anexos do Outlook - Guardar

[cmp]

Olá

Gostaria de guardar os meus anexos do Outlook todos de uma só vez selecionando os vários mails. Existe algum software que resolva o meu problema.

Obrigado

[Migas]

Penso que não..pelo menos eu não conheço..abre um a um e save.

[KrIaXPaTaLa]

Encontrei este código e dei-lhe uns toque porque tinha alguns pormenores "parvos", como apagar o attach dp de o salvar (não gostei). Alterei isso e o resultado é este, julgo fazer o que queres:

Código: Seleccionar todos

Sub SaveAttachment()

    'Declaration
    Dim myItems, myItem, myAttachments, myAttachment As Object
    Dim myOrt As String
    Dim myOlApp As New Outlook.Application
    Dim myOlExp As Outlook.Explorer
    Dim myOlSel As Outlook.Selection
   
    'Ask for destination folder
    myOrt = InputBox("Destination (must end with a \)", "Save Attachments", "C:\")

    On Error Resume Next
   
    'work on selected items
    Set myOlExp = myOlApp.ActiveExplorer
    Set myOlSel = myOlExp.Selection
   
    'for all items do...
    For Each myItem In myOlSel
   
        'point on attachments
        Set myAttachments = myItem.Attachments
       
        'if there are some...
        If myAttachments.Count > 0 Then
       
            'add remark to message text
            myItem.Body = myItem.Body & vbCrLf & _
                "Saved Attachments:" & vbCrLf
               
            'for all attachments do...
            For i = 1 To myAttachments.Count
           
                'save them to destination
                myAttachments(i).SaveAsFile myOrt & _
                    myAttachments(i).DisplayName

                'add name and destination to message text
                myItem.Body = myItem.Body & _
                    "File: " & myOrt & _
                    myAttachments(i).DisplayName & vbCrLf
                   
            Next i
           
            'for all attachments do...
            'While myAttachments.Count > 0
           
                'remove it (use this method in Outlook XP)
                'myAttachments.Remove 1
               
                'remove it (use this method in Outlook 2000)
                'myAttachments(1).Delete
               
            'Wend
           
            'save item without attachments
            'myItem.Save
        End If
       
    Next
   
    'free variables
    Set myItems = Nothing
    Set myItem = Nothing
    Set myAttachments = Nothing
    Set myAttachment = Nothing
    Set myOlApp = Nothing
    Set myOlExp = Nothing
    Set myOlSel = Nothing
   

End Sub

A forma de usares isto é simples:

- No outlook, menu tools -> macro -> macros;

- Das-lhe o nome SaveAttachment e fazes "create";

- No editor de macros, substituis o código que lá estiver por este e gravas;

Depois, para simplificar, vais criar um botão de acesso directo à macro:

- menu tools -> customize

- separador "commands"

- na categoria escolhes "macros" e a tua macro deve aparecer-te à direita em "commands" com o nome Project1.SaveAttachment. Arrastas a macro para uma das barras de ferramentas do outlook e ficará lá o botão.

Agora é só seleccionares os mails com os attachs (todos), carregar no botão e escolher a pasta onde queres gravar (atenção, que o caminho para a pasta TEM que terminar com barra \ senão o gajo assume que é um nome que queres dar ao ficheiro e o resultado não é drástico, mas também não é bonito).

Só mais uma coisa. O outlook, quando corres o código queixa-se de qualquer merd* de segurança. Diz ao gajo para deixar andar. Se entenderes minimante de programação ou scripting, ves que isso n tem nada de mal.

Cumprimentos,

KrIaX.