it-swarm.com.de

Speichern Sie Anhänge in einem Ordner und benennen Sie sie um

Ich versuche, ein VBA-Makro in Outlook zu erhalten, das den Anhang einer E-Mail in einem bestimmten Ordner speichert und dem Dateinamen das Datum receive hinzufügt. 

Mein Googling hat mich so weit gebracht:

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

Die erste offensichtliche Sache ist, dass die aktuelle Zeit auf den Dateinamen anstatt auf die empfangene Zeit angewendet wird. Ich kann sie jedoch nicht ändern. Meine Theorie ist, dass das Outlook.Attachment keine ReceivedTime hat und dass die E-Mail selbst referenziert werden muss.

Zweitens scheint das überhaupt nicht zu funktionieren, ha! Am ersten Tag, an dem ich anfing zu basteln, klappte es, aber danach wurden keine Dateien mehr gespeichert.

35
Roy Haskell

Dies ist mein Skript zum Speichern von Anhängen. Sie wählen alle Nachrichten aus, aus denen die Anlagen gespeichert werden sollen, und speichern dort eine Kopie. Außerdem wird dem Nachrichtentext Text hinzugefügt, der angibt, wo die Anlage gespeichert wird. Sie können den Ordnernamen einfach so ändern, dass er das Datum enthält. Sie müssen jedoch sicherstellen, dass der Ordner vorhanden ist, bevor Sie mit dem Speichern der Dateien beginnen.

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
32
Stuart

Siehe ReceivedTime-Eigenschaft

http://msdn.Microsoft.com/de-de/library/office/aa171873(v=office.11).aspx

Sie haben ein weiteres \ am Ende von C:\Temp\ in der Zeile SaveAs File hinzugefügt. Könnte ein Problem sein. Führen Sie zunächst einen Test durch, bevor Sie ein Pfadtrennzeichen hinzufügen.

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

Sie haben objAtt nicht festgelegt, sodass "Set objAtt = Nothing" nicht erforderlich ist. Wenn ja, wäre es kurz vor End Sub nicht in der Schleife.


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: Am ersten Tag, an dem ich angefangen habe zu basteln, hat es funktioniert, aber danach wurden keine Dateien mehr gespeichert.

Dies liegt normalerweise an den Sicherheitseinstellungen. Es ist eine "Falle" für erstmalige Benutzer, die Makros zulassen und sie dann wegnehmen können. http://www.slipstick.com/Outlook-developer/how-to-use-outlooks-vba-editor/

5
niton

Ihre Frage hat 2 Aufgaben, die erledigt werden müssen. Extrahieren Sie zuerst die E-Mail-Anhänge in einen Ordner und speichern oder benennen Sie sie unter einem bestimmten Namen. 

Wenn Ihre Suche auf 2 Suchvorgänge aufgeteilt werden kann, erhalten Sie mehr Treffer. Ich könnte auf eine Seite verweisen, die erklärt, wie der Anhang in einem Systemordner gespeichert wird. < Link für die Seite, um Anlagen in einem Ordner zu speichern >.

Bitte posten Sie eine Seite oder einen Code, wenn Sie den Anhang unter einem bestimmten Namen gespeichert haben.

1
KumaraPush

Einfacher Code zum Speichern mit lesbarem Datums-/Zeitstempel hinzugefügt.

Verwenden Sie sync2pst , um alle Ihre Daten in Outlook mit allen Ihren Geräten zu synchronisieren. Gehen Sie folgendermaßen vor:

  1. sie müssen nur eine Lizenz kaufen: Speichern Sie Ihre PST-Datei auf einem Computer (nennen Sie diesen PC "Server") in Ihrem Netzwerk.
  2. erstellen Sie geplante Aufgaben, die die PST-Datei auf Ihrem 'Server' mit allen Pst-Dateien auf allen Geräten synchronisieren, unabhängig davon, welches Gerät die E-Mails zuerst heruntergeladen hat (Sie benötigen einige Programmierkenntnisse, um PST-Dateien zu umgehen, die zur Synchronisierungszeit geöffnet sind. .
  3. speichern Sie alle Ihre Anhänge in demselben Skydrive-Ordner, der sich auf allen Ihren Geräten an derselben Stelle befindet (z. B. E:\Skydrive\Attachments).
  4. Verwenden Sie den folgenden Code auf allen Ihren Geräten, um Anhänge zu speichern (ändern Sie den Pfad wie oben erwähnt).
  5. Verwenden Sie ONLY ONE PST-file für alle Ihre Konten, machen Sie Ordner, Unterordner und so ...

  6. in VBA: siehe 'Microsoft scripting runtime' extra/referenzen ... '

  7. hier ist der 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
user2485790
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
David

Ich hatte das zwar nicht lange nach dem Posting gelöst, konnte aber meine Lösung nicht posten. Ich kann mich ehrlich nicht daran erinnern. Aber ich musste die Aufgabe erneut besuchen, als ich ein neues Projekt bekam, das vor der gleichen Herausforderung stand.

Ich habe die ReceivedTime-Eigenschaft von Outlook.MailItem verwendet, um den Zeitstempel zu erhalten. Ich konnte diese Eigenschaft als eindeutigen Bezeichner für jede Datei verwenden, damit sie sich nicht überschreiben.

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

Vielen Dank für die anderen Lösungen, viele davon gehen über ein Jenseits hinaus :) 

0
Roy Haskell