Pertanyaan Simpan lampiran ke folder dan ganti namanya


Saya mencoba mendapatkan makro VBA di Outlook yang akan menyimpan lampiran email ke folder tertentu dan menambahkan tanggal diterima ke nama file.

Googling saya telah membuat saya sejauh ini:

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

Yang jelas pertama adalah bahwa itu menerapkan waktu saat ini ke nama file, bukan waktu yang diterima, tetapi saya tidak bisa mengubahnya. Teori saya adalah bahwa Outlook.Attachment tidak memiliki ReceivedTime dan bahwa email itu sendiri harus dirujuk.

Kedua, ini sepertinya tidak berfungsi sama sekali, ha! Ini berhasil pada hari pertama saya mulai mengotak-atik tetapi setelah itu berhenti menyimpan file.


32
2018-03-20 17:50


asal


Jawaban:


Ini adalah skrip Simpan Lampiran saya. Anda memilih semua pesan yang Anda inginkan dari lampiran yang disimpan, dan itu akan menyimpan salinannya di sana. Itu juga menambahkan teks ke badan pesan yang menunjukkan di mana lampiran disimpan. Anda dapat dengan mudah mengubah nama folder untuk memasukkan tanggal, tetapi Anda harus memastikan folder itu ada sebelum mulai menyimpan file.

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
2018-03-20 18:10



Lihat ReceivedTime Milik

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

Anda menambahkan yang lain \ sampai akhir C:\Temp\ dalam SaveAs File garis. Bisa jadi masalah. Lakukan tes terlebih dahulu sebelum menambahkan pemisah jalur.

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

Anda belum mengatur objAtt jadi tidak perlu untuk "Set objAtt = Nothing". Jika ada sebelum itu End Sub tidak dalam lingkaran.


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: Ini berhasil pada hari pertama saya mulai mengotak-atik tetapi setelah itu berhenti menyimpan file.

Ini biasanya karena pengaturan Keamanan. Ini adalah "perangkap" yang ditetapkan untuk pengguna pertama kali untuk memungkinkan makro lalu mengambilnya. http://www.slipstick.com/outlook-developer/how-to-use-outlooks-vba-editor/


5
2018-03-20 18:43



Pertanyaan Anda memiliki 2 tugas yang harus dilakukan. Pertama untuk mengekstrak lampiran Email ke folder dan menyimpan atau mengganti nama dengan nama tertentu.

Jika pencarian Anda dapat dibagi menjadi 2 pencarian, Anda akan mendapatkan lebih banyak klik. Saya bisa merujuk satu halaman yang menjelaskan cara menyimpan lampiran ke folder sistem <Tautan untuk halaman untuk menyimpan lampiran ke folder>.

Silakan posting halaman atau kode apa pun jika Anda telah menemukan untuk menyimpan lampiran dengan nama tertentu.


1
2018-03-30 08:58



Menambahkan kode sederhana untuk disimpan dengan stempel tanggal yang dapat dibaca.

Menggunakan sync2pst untuk menyinkronkan semua data Anda dengan semua perangkat Anda, bekerja seperti ini:

  1. Anda hanya perlu membeli 1 lisensi: simpan file pst Anda di satu komputer (sebut saja pc 'server' ini) di jaringan Anda.
  2. buat tugas terjadwal yang akan menyinkronkan file pst di 'server' Anda dengan semua file pst di semua perangkat Anda, tidak peduli perangkat mana yang mengunduh surel terlebih dahulu (Anda memerlukan pengetahuan pemrograman dos untuk mem-bypass file pst yang dibuka pada waktu sinkronisasi) .
  3. simpan semua lampiran Anda di folder skydrive yang sama yang terletak di tempat yang sama di semua perangkat Anda (mis. e: \ skydrive \ lampiran)
  4. Gunakan kode di bawah ini di semua perangkat Anda untuk menyimpan lampiran (ubah jalur seperti yang disebutkan di atas)
  5. Menggunakan HANYA SATU PST-file untuk semua akun Anda, buat folder, subfolder, dan sebagainya ...

  6. di VBA: lihat 'microsoft scripting runtime'ekstra / referensi ...'

  7. ini kodenya

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
2018-06-14 11:21



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
2017-07-25 16:02



Sebenarnya saya telah menyelesaikan ini tidak lama setelah posting tetapi gagal memposting solusi saya. Sejujurnya aku tidak mengingatnya. Tapi, saya harus kembali mengunjungi tugas ketika saya diberi proyek baru yang menghadapi tantangan yang sama.

Saya menggunakan properti ReceivedTime Outlook.MailItem untuk mendapatkan cap waktu, saya bisa menggunakan ini sebagai pengenal unik untuk setiap file sehingga mereka tidak mengesampingkan satu sama lain.

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

Terima kasih banyak untuk solusi lainnya, banyak di antaranya yang melampaui :)


0
2017-11-26 00:26