Sauvegarder les pièces jointes dans un dossier et les renommer

j'essaie D'obtenir une macro VBA dans Outlook qui enregistrera la pièce jointe d'un email dans un dossier spécifique et ajoutera la date reçu au nom du fichier.

mon googling m'a amené jusqu'ici:

Public Sub saveAttachtoDisk (itm As Outlook.MailItem) 
    Dim objAtt As Outlook.Attachment 
    Dim saveFolder As String
    Dim dateFormat As String
    saveFolder = "C:Temp"
    dateFormat = Format(Now, "yyyy-mm-dd H-mm")

    For Each objAtt In itm.Attachments
        objAtt.SaveAsFile saveFolder & "" & dateFormat & objAtt.DisplayName
        Set objAtt = Nothing
    Next 
End Sub

la première chose évidente est qu'il applique l'heure courante au nom du fichier au lieu de l'heure reçue, mais je ne peux pas le changer. Ma théorie est que les Perspectives.L'attachement n'a pas de ReceivedTime et que le message lui-même doit être référencé.

deuxièmement, cela ne semble pas fonctionner du tout, ha! Ça a marché le premier jour où j'ai commencé à bricoler mais après ça, ça a arrêté de sauvegarder des fichiers.

33
demandé sur Myrddin Emrys 2013-03-20 21:50:19

6 réponses

ceci est mon script de sauvegarde des pièces jointes. Vous sélectionnez tous les messages à partir desquels vous voulez sauvegarder les pièces jointes, et vous en enregistrerez une copie. Il ajoute également du texte au corps du message indiquant où la pièce jointe est sauvegardée. Vous pouvez facilement changer le nom du dossier à inclure la date, mais vous devez vous assurer que le dossier existe avant de commencer à enregistrer des fichiers.

Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String

' Get the path to your My Documents folder
strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
On Error Resume Next

' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")

' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection

' Set the Attachment folder.
strFolderpath = strFolderpath & "\Attachments\"

' Check each selected item for attachments. If attachments exist,
' save them to the strFolderPath folder and strip them from the item.
For Each objMsg In objSelection

    ' This code only strips attachments from mail items.
    ' If objMsg.class=olMail Then
    ' Get the Attachments collection of the item.
    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count
    strDeletedFiles = ""

    If lngCount > 0 Then

        ' We need to use a count down loop for removing items
        ' from a collection. Otherwise, the loop counter gets
        ' confused and only every other item is removed.

        For i = lngCount To 1 Step -1

            ' Save attachment before deleting from item.
            ' Get the file name.
            strFile = objAttachments.Item(i).FileName

            ' Combine with the path to the Temp folder.
            strFile = strFolderpath & strFile

            ' Save the attachment as a file.
            objAttachments.Item(i).SaveAsFile strFile

            ' Delete the attachment.
            objAttachments.Item(i).Delete

            'write the save as path to a string to add to the message
            'check for html and use html tags in link
            If objMsg.BodyFormat <> olFormatHTML Then
                strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">"
            Else
                strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _
                strFile & "'>" & strFile & "</a>"
            End If

            'Use the MsgBox command to troubleshoot. Remove it from the final code.
            'MsgBox strDeletedFiles

        Next i

        ' Adds the filename string to the message body and save it
        ' Check for HTML body
        If objMsg.BodyFormat <> olFormatHTML Then
            objMsg.Body = vbCrLf & "The file(s) were saved to " & strDeletedFiles & vbCrLf & objMsg.Body
        Else
            objMsg.HTMLBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" & objMsg.HTMLBody
        End If
        objMsg.Save
    End If
Next

ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub
30
répondu Stuart 2015-04-28 21:29:53

Voir ReceivedTime Propriété

http://msdn.microsoft.com/en-us/library/office/aa171873(v=office.11).aspx

Vous avez ajouté un autre \ à la fin de C:\Temp\ dans le Fichier SaveAs ligne. Pourrait être un problème. Faites d'abord un test avant d'ajouter un séparateur de chemin.

dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd H-mm")  
saveFolder = "C:\Temp"

Vous n'avez pas défini objAtt il n'y a donc pas besoin de "Set objAtt = Nothing". S'il y avait, il serait juste avant End Sub pas dans le boucle.


Public Sub saveAttachtoDisk (itm As Outlook.MailItem) 
    Dim objAtt As Outlook.Attachment 
    Dim saveFolder As String Dim dateFormat
    dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd H-mm")  saveFolder = "C:\Temp"
    For Each objAtt In itm.Attachments
        objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
    Next
End Sub

Re: ça a marché le premier jour où j'ai commencé à bricoler mais après ça, ça a arrêté de sauvegarder des fichiers.

ceci est généralement dû aux paramètres de sécurité. C'est un "piège" ensemble pour la première fois les utilisateurs à autoriser les macros. http://www.slipstick.com/outlook-developer/how-to-use-outlooks-vba-editor/

5
répondu niton 2015-04-28 21:33:02

votre question comporte 2 tâches à accomplir. D'abord pour extraire les pièces jointes à un dossier et d'économie ou de le renommer avec un nom spécifique.

si votre recherche peut être divisée en 2 recherches, Vous obtiendrez plus de résultats. Je pourrais renvoyer une page qui explique comment sauvegarder la pièce jointe dans un dossier système<lien pour la page pour sauvegarder les pièces jointes dans un dossier>.

veuillez afficher n'importe quelle page ou code si vous avez trouvé pour sauvegarder la pièce jointe avec spécifique nom.

1
répondu KumaraPush 2014-03-30 08:58:39

Ajout de code simple pour enregistrer lisible horodatage.

Utiliser sync2pst synchroniser toutes vos données dans outlook avec tous vos appareils, fonctionne comme ceci:

  1. vous avez seulement besoin d'acheter 1 licence: enregistrez votre fichier pst sur un ordinateur (appelons ce pc "serveur") sur votre réseau.
  2. créer des tâches planifiées qui va synchroniser le fichier pst sur votre "serveur" avec tous les fichiers pst sur tous vos appareils, quel que soit l'appareil téléchargé le les e-mails d'abord (vous avez besoin de quelques connaissances de programmation dos pour contourner les fichiers pst qui sont ouverts au moment de la synchronisation).
  3. enregistrez toutes vos pièces jointes sur le même dossier skydrive qui est situé au même endroit sur tous vos appareils (par ex. e:\skydrive\attachments)--10-->
  4. utilisez le code ci-dessous sur tous vos appareils pour sauvegarder les pièces jointes (changez le chemin comme mentionné ci-dessus)
  5. Utiliser un seul fichier PST pour tous vos comptes, faire des dossiers, sous-dossiers et ainsi de ...

  6. dans VBA: se référer à'microsoft scripting runtime'extra/références...'

  7. voici le code

Private Sub Application_NewMail()
SaveAttachments
End Sub

Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String
Dim fs As FileSystemObject

' Get the path to your My Documents folder
strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
On Error Resume Next

' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")

' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection

' Set the Attachment folder.
strFolderpath = "F:\SkyDrive\Attachments\"

' Check each selected item for attachments. If attachments exist,
' save them to the strFolderPath folder and strip them from the item.
For Each objMsg In objSelection

    ' This code only strips attachments from mail items.
    ' If objMsg.class=olMail Then
    ' Get the Attachments collection of the item.
    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count
    strDeletedFiles = ""

    If lngCount > 0 Then

        ' We need to use a count down loop for removing items
        ' from a collection. Otherwise, the loop counter gets
        ' confused and only every other item is removed.
        Set fs = New FileSystemObject

        For i = lngCount To 1 Step -1

            ' Save attachment before deleting from item.
            ' Get the file name.
            strFile = Left(objAttachments.Item(i).FileName, Len(objAttachments.Item(i).FileName) - 4) + "_" + Right("00" + Trim(Str$(Day(Now))), 2) + "_" + Right("00" + Trim(Str$(Month(Now))), 2) + "_" + Right("0000" + Trim(Str$(Year(Now))), 4) + "_" + Right("00" + Trim(Str$(Hour(Now))), 2) + "_" + Right("00" + Trim(Str$(Minute(Now))), 2) + "_" + Right("00" + Trim(Str$(Second(Now))), 2) + Right((objAttachments.Item(i).FileName), 4)

            ' Combine with the path to the Temp folder.
            strFile = strFolderpath & strFile

            ' Save the attachment as a file.
            objAttachments.Item(i).SaveAsFile strFile

            ' Delete the attachment.
            objAttachments.Item(i).Delete

            'write the save as path to a string to add to the message
            'check for html and use html tags in link
            If objMsg.BodyFormat <> olFormatHTML Then
                strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">"
            Else
                strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _
                strFile & "'>" & strFile & "</a>"
            End If

            'Use the MsgBox command to troubleshoot. Remove it from the final code.
            'MsgBox strDeletedFiles

        Next i

        ' Adds the filename string to the message body and save it
        ' Check for HTML body
        If objMsg.BodyFormat <> olFormatHTML Then
            objMsg.Body = vbCrLf & "The file(s) were saved to " & strDeletedFiles & vbCrLf & objMsg.Body
        Else
            objMsg.HTMLBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" & objMsg.HTMLBody
        End If

        objMsg.Save
    End If
Next

ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub
1
répondu user2485790 2015-04-28 21:37:48
Public Sub Extract_Outlook_Email_Attachments()

Dim OutlookOpened As Boolean
Dim outApp As Outlook.Application
Dim outNs As Outlook.Namespace
Dim outFolder As Outlook.MAPIFolder
Dim outAttachment As Outlook.Attachment
Dim outItem As Object
Dim saveFolder As String
Dim outMailItem As Outlook.MailItem
Dim inputDate As String, subjectFilter As String


saveFolder = "Y:\Wingman" ' THIS IS WHERE YOU WANT TO SAVE THE ATTACHMENT TO

If Right(saveFolder, 1) <> "\" Then saveFolder = saveFolder & "\"

subjectFilter = ("Daily Operations Custom All Req Statuses Report") ' THIS IS WHERE YOU PLACE THE EMAIL SUBJECT FOR THE CODE TO FIND

OutlookOpened = False
On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
    Set outApp = New Outlook.Application
    OutlookOpened = True
End If
On Error GoTo 0

If outApp Is Nothing Then
    MsgBox "Cannot start Outlook.", vbExclamation
    Exit Sub
End If

Set outNs = outApp.GetNamespace("MAPI")
Set outFolder = outNs.GetDefaultFolder(olFolderInbox)

If Not outFolder Is Nothing Then
    For Each outItem In outFolder.Items
        If outItem.Class = Outlook.OlObjectClass.olMail Then
            Set outMailItem = outItem
                If InStr(1, outMailItem.Subject, "subjectFilter") > 0 Then
                    For Each outAttachment In outMailItem.Attachments
                    outAttachment.SaveAsFile saveFolder & outAttachment.filename

                    Set outAttachment = Nothing

                    Next
                End If
        End If
    Next
End If

If OutlookOpened Then outApp.Quit

Set outApp = Nothing

End Sub
1
répondu David 2016-07-25 16:02:51

j'avais résolu ce peu de temps après l'affichage, mais pas réussi à poster ma solution. Honnêtement, je ne m'en souviens pas. Mais j'ai dû réexaminer la tâche lorsque j'ai reçu un nouveau projet qui faisait face au même défi.

j'ai utilisé la propriété ReceivedTime D'Outlook.MailItem pour obtenir l'horodatage, j'ai pu l'utiliser comme un identifiant unique pour chaque fichier afin qu'ils ne se supplantent pas l'un l'autre.

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
        saveFolder = "C:\PathToDirectory\"
    Dim dateFormat As String
        dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd Hmm ")
    For Each objAtt In itm.Attachments
        objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
    Next
End Sub

Merci une tonne pour les autres solutions, beaucoup d'entre eux vont au-dessus d'un au-delà :)

0
répondu Roy Haskell 2013-11-26 00:26:13