Note: The other languages of the website are Google-translated. Back to English
Mewngofnodi  \/ 
x
or
x
Cofrestru  \/ 
x

or

Sut i arbed pob atodiad o e-byst lluosog i ffolder yn Outlook?

Mae'n hawdd arbed pob atodiad o e-bost gyda'r nodwedd adeiledig Save All Attachments yn Outlook. Fodd bynnag, os ydych chi am arbed pob atodiad o sawl e-bost ar unwaith, nid oes unrhyw nodwedd uniongyrchol a all helpu. Mae angen i chi gymhwyso'r nodwedd Cadw Pob Atodiad dro ar ôl tro ym mhob e-bost nes bod yr holl atodiadau yn cael eu cadw o'r e-byst hynny. Mae hynny'n cymryd llawer o amser. Yn yr erthygl hon, rydym yn cyflwyno dau ddull i chi swmp-arbed pob atodiad o sawl e-bost i ffolder benodol yn hawdd yn Outlook.

Cadwch bob atodiad o sawl e-bost i ffolder gyda chod VBA
Sawl clic i arbed pob atodiad o e-byst lluosog i ffolder gydag offeryn anhygoel


Cadwch bob atodiad o sawl e-bost i ffolder gyda chod VBA

Mae'r adran hon yn dangos cod VBA mewn canllaw cam wrth gam i'ch helpu chi i arbed pob atodiad yn gyflym o sawl e-bost i ffolder benodol ar unwaith. Gwnewch fel a ganlyn.

1. Yn gyntaf, mae angen i chi greu ffolder ar gyfer arbed yr atodiadau yn eich cyfrifiadur.

Ewch i mewn i'r dogfennau ffolder a chreu ffolder o'r enw “Atodiadau”. Gweler y screenshot:

2. Dewiswch yr e-byst y bydd yr atodiadau y byddwch yn eu cadw, ac yna pwyswch Alt + F11 allweddi i agor y Microsoft Visual Basic ar gyfer Ceisiadau ffenestr.

3. Cliciwch Mewnosod > Modiwlau i agor y Modiwlau ffenestr, ac yna copïwch un o'r cod VBA canlynol i'r ffenestr.

Cod VBA 1: Atodiadau swmp-arbed o sawl e-bost (arbedwch atodiadau union yr un enw yn uniongyrchol)

Awgrymiadau: Bydd y cod hwn yn arbed atodiadau union yr un enw trwy ychwanegu digidau 1, 2, 3 ... ar ôl enwau ffeiliau.

Dim GCount As Integer
Dim GFilepath As String
Public Sub SaveAttachments()
'Update 20200821
Dim xMailItem As Outlook.MailItem
Dim xAttachments As Outlook.Attachments
Dim xSelection As Outlook.Selection
Dim i As Long
Dim xAttCount As Long
Dim xFilePath As String, xFolderPath As String, xSaveFiles As String
On Error Resume Next
xFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
Set xSelection = Outlook.Application.ActiveExplorer.Selection
xFolderPath = xFolderPath & "\Attachments\"
If VBA.Dir(xFolderPath, vbDirectory) = vbNullString Then
    VBA.MkDir xFolderPath
End If
GFilepath = ""
For Each xMailItem In xSelection
    Set xAttachments = xMailItem.Attachments
    xAttCount = xAttachments.Count
    xSaveFiles = ""
    If xAttCount > 0 Then
        For i = xAttCount To 1 Step -1
            GCount = 0
            xFilePath = xFolderPath & xAttachments.Item(i).FileName
            GFilepath = xFilePath
            xFilePath = FileRename(xFilePath)
            If IsEmbeddedAttachment(xAttachments.Item(i)) = False Then
                xAttachments.Item(i).SaveAsFile xFilePath
                If xMailItem.BodyFormat <> olFormatHTML Then
                    xSaveFiles = xSaveFiles & vbCrLf & "<Error! Hyperlink reference not valid.>"
                Else
                    xSaveFiles = xSaveFiles & "<br>" & "<a href='file://" & xFilePath & "'>" & xFilePath & "</a>"
                End If
            End If
        Next i
        If xSaveFiles <> "" Then
            If xMailItem.BodyFormat <> olFormatHTML Then
                xMailItem.Body = vbCrLf & "The file(s) were saved to " & xSaveFiles & vbCrLf & xMailItem.Body
            Else
                xMailItem.HTMLBody = "<p>" & "The file(s) were saved to " & xSaveFiles & "</p>" & xMailItem.HTMLBody
            End If
        End If
        xMailItem.Save
    End If
Next
Set xAttachments = Nothing
Set xMailItem = Nothing
Set xSelection = Nothing
End Sub

Function FileRename(FilePath As String) As String
Dim xPath As String
Dim xFso As FileSystemObject
On Error Resume Next
Set xFso = CreateObject("Scripting.FileSystemObject")
xPath = FilePath
FileRename = xPath
If xFso.FileExists(xPath) Then
    GCount = GCount + 1
    xPath = xFso.GetParentFolderName(GFilepath) & "\" & xFso.GetBaseName(GFilepath) & " " & GCount & "." + xFso.GetExtensionName(GFilepath)
    FileRename = FileRename(xPath)
End If
xFso = Nothing
End Function

Function IsEmbeddedAttachment(Attach As Attachment)
Dim xItem As MailItem
Dim xCid As String
Dim xID As String
Dim xHtml As String
On Error Resume Next
IsEmbeddedAttachment = False
Set xItem = Attach.Parent
If xItem.BodyFormat <> olFormatHTML Then Exit Function
xCid = ""
xCid = Attach.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F")
If xCid <> "" Then
    xHtml = xItem.HTMLBody
    xID = "cid:" & xCid
    If InStr(xHtml, xID) > 0 Then
        IsEmbeddedAttachment = True
    End If
End If
End Function
Cod VBA 2: Atodiadau swmp-arbed o sawl e-bost (gwiriwch am ddyblygiadau)
Public Sub SaveAttachments()
'Update 20200821
Dim xMailItem As Outlook.MailItem
Dim xAttachments As Outlook.Attachments
Dim xSelection As Outlook.Selection
Dim i As Long
Dim xAttCount As Long
Dim xFilePath As String, xFolderPath As String, xSaveFiles As String
Dim xYesNo As Integer
Dim xFlag As Boolean
On Error Resume Next
xFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
Set xSelection = Outlook.Application.ActiveExplorer.Selection
xFolderPath = xFolderPath & "\Attachments\"
If VBA.Dir(xFolderPath, vbDirectory) = vbNullString Then
    VBA.MkDir xFolderPath
End If
For Each xMailItem In xSelection
    Set xAttachments = xMailItem.Attachments
    xAttCount = xAttachments.Count
    xSaveFiles = ""
    If xAttCount > 0 Then
        For i = xAttCount To 1 Step -1
            xFilePath = xFolderPath & xAttachments.Item(i).FileName
            xFlag = True
            If VBA.Dir(xFilePath, 16) <> Empty Then
                xYesNo = MsgBox("The file is exists, do you want to replace it", vbYesNo + vbInformation, "Kutools for Outlook")
                If xYesNo = vbNo Then xFlag = False
            End If
            If xFlag = True Then
                xAttachments.Item(i).SaveAsFile xFilePath
                If xMailItem.BodyFormat <> olFormatHTML Then
                    xSaveFiles = xSaveFiles & vbCrLf & "<Error! Hyperlink reference not valid.>"
                Else
                    xSaveFiles = xSaveFiles & "<br>" & "<a href='file://" & xFilePath & "'>" & xFilePath & "</a>"
                End If
            End If
        Next i
        If xSaveFiles <> "" Then
            If xMailItem.BodyFormat <> olFormatHTML Then
                xMailItem.Body = vbCrLf & "The file(s) were saved to " & xSaveFiles & vbCrLf & xMailItem.Body
            Else
                xMailItem.HTMLBody = "<p>" & "The file(s) were saved to " & xSaveFiles & "</p>" & xMailItem.HTMLBody
            End If
        End If
        xMailItem.Save
    End If
Next
Set xAttachments = Nothing
Set xMailItem = Nothing
Set xSelection = Nothing
End Sub

Nodiadau:

1) Os ydych chi am arbed pob atodiad o'r un enw mewn ffolder, cymhwyswch yr uchod Cod VBA 1. Cyn rhedeg y cod hwn, cliciwch offer > cyfeiriadau, ac yna gwiriwch y Microsoft Scripting Runtime blwch yn y Cyfeiriadau - Prosiect blwch deialog;

doc arbed atodiadau07

2) Os ydych chi am wirio am enwau atodiadau dyblyg, cymhwyswch god VBA 2. Ar ôl rhedeg y cod, bydd deialog yn ymddangos i'ch atgoffa a ddylid amnewid yr atodiadau dyblyg, dewiswch Ydw or Na yn seiliedig ar eich anghenion.

5. Gwasgwch y F5 allwedd i redeg y cod.

Yna mae'r holl atodiadau mewn e-byst dethol yn cael eu cadw i'r ffolder a greoch yng ngham 1. Fe welwch fod hypergysylltiadau wedi'u harddangos mewn e-byst dethol. Bydd clicio ar y ddolen yn agor yr atodiad penodol yn awtomatig.

Nodyn: Efallai y bydd a Microsoft Outlook blwch prydlon popping up, cliciwch y Caniatáu botwm i fynd ymlaen.


Cadwch bob atodiad o e-byst lluosog i ffolder gydag offeryn anhygoel

Os ydych chi'n newbie yn VBA, dyma argymell y Cadw Pob atodiad cyfleustodau Kutools ar gyfer Outook i chi. Gyda'r cyfleustodau hwn, gallwch arbed pob atodiad yn gyflym o sawl e-bost ar unwaith gyda sawl clic yn Outlook yn unig.
Cyn defnyddio'r nodwedd, os gwelwch yn dda lawrlwytho a gosod Kutools ar gyfer Outlook yn gyntaf.

1. Dewiswch yr e-byst sy'n cynnwys yr atodiadau rydych chi am eu cadw.

Awgrym: Gallwch ddewis sawl e-bost nad ydynt yn gyfagos trwy ddal y Ctrl allwedd a'u dewis fesul un;
Neu dewiswch sawl e-bost cyfagos trwy ddal y Symud allwedd a dewis yr e-bost cyntaf a'r un olaf.

2. Cliciwch Kutools >Offer YmlyniadArbed i Bawb. Gweler y screenshot:

3. Yn y Cadw Gosodiadau deialog, cliciwch y botwm i ddewis ffolder i achub yr atodiadau, ac yna cliciwch ar y OK botwm.

3. Cliciwch OK ddwywaith yn y blwch popio nesaf i'r blwch deialog, Yna mae'r holl atodiadau mewn e-byst dethol yn cael eu cadw mewn ffolder benodol ar unwaith.

Nodiadau:

  • 1. Os ydych chi am arbed atodiadau mewn gwahanol ffolderau yn seiliedig ar e-byst, gwiriwch y Creu is-ffolderi yn yr arddull ganlynol blwch, a dewis arddull ffolder o'r gwymplen.
  • 2. Ar wahân i arbed pob atodiad, gallwch arbed atodiadau yn ôl amodau penodol. Er enghraifft, dim ond yr atodiadau ffeil pdf y mae enw'r ffeil yn cynnwys y gair "Anfoneb" yr ydych am eu cadw, cliciwch ar y Dewisiadau mwy cymhleth botwm i ehangu'r amodau, ac yna ffurfweddu fel y sgriw isod.
  • 3. Os ydych chi am arbed atodiadau yn awtomatig wrth i e-bost gyrraedd, bydd y Atodiadau Auto Save gall nodwedd helpu.
  • 4. Ar gyfer datgysylltu'r atodiadau yn uniongyrchol o e-byst dethol, mae'r Datgysylltwch Pob atodiad nodwedd o Kutools ar gyfer Rhagolwg allwch chi o blaid.

  Os ydych chi am gael treial am ddim (60 diwrnod) o'r cyfleustodau hwn, cliciwch i'w lawrlwytho, ac yna ewch i gymhwyso'r llawdriniaeth yn ôl y camau uchod.


Erthyglau perthnasol

Mewnosod atodiadau yng nghorff y neges e-bost yn Outlook
Fel rheol mae atodiadau yn cael eu harddangos yn y maes Atodedig mewn e-bost cyfansoddi. Yma mae'r tiwtorial hwn yn darparu dulliau i'ch helpu chi i fewnosod atodiadau yn y corff e-bost yn Outlook yn hawdd.

Dadlwythwch / arbed atodiadau yn awtomatig o Outlook i ffolder benodol
A siarad yn gyffredinol, gallwch arbed pob atodiad o un e-bost trwy glicio Atodiadau> Cadw Pob Atodiad yn Outlook. Ond, os oes angen i chi arbed pob atodiad o'r holl negeseuon e-bost a dderbynnir a derbyn e-byst, unrhyw ddelfrydol? Bydd yr erthygl hon yn cyflwyno dau ddatrysiad i lawrlwytho atodiadau o Outlook yn awtomatig i ffolder benodol.

Argraffwch yr holl atodiadau mewn un e-bost / lluosog yn Outlook
Fel y gwyddoch, dim ond pan gliciwch y Ffeil> Argraffu yn Microsoft Outlook y bydd yn argraffu'r cynnwys e-bost fel pennawd, corff, ond nid argraffu'r atodiadau. Yma byddwn yn dangos i chi sut i argraffu pob atodiad mewn e-bost dethol yn gartrefol yn Microsoft Outlook.

Chwilio geiriau o fewn atodiad (cynnwys) yn Outlook
Pan fyddwn yn teipio allweddair yn y blwch Chwilio ar Unwaith yn Outlook, bydd yn chwilio'r allweddair ym mhynciau, cyrff, atodiadau ac ati e-byst. Ond nawr does dim ond angen i mi chwilio'r allweddair mewn cynnwys atodiad yn Outlook yn unig, unrhyw syniad? Mae'r erthygl hon yn dangos i chi'r camau manwl i chwilio geiriau o fewn cynnwys atodiadau yn Outlook yn hawdd.

Cadwch atodiadau wrth ateb yn Outlook
Pan anfonwn neges e-bost yn Microsoft Outlook, mae atodiadau gwreiddiol yn y neges e-bost hon yn aros yn y neges a anfonwyd ymlaen. Fodd bynnag, pan fyddwn yn ateb neges e-bost, ni fydd yr atodiadau gwreiddiol ynghlwm yn y neges ateb newydd. Yma, rydyn ni'n mynd i gyflwyno cwpl o driciau am gadw atodiadau gwreiddiol wrth ateb yn Microsoft Outlook.


Kutools for Outlook - Yn Dod â 100 o Nodweddion Uwch i'w Rhagweld, a Gwneud Gwaith yn Haws Osgach!

  • Auto CC / BCC yn ôl rheolau wrth anfon e-bost; Auto Ymlaen E-byst Lluosog yn ôl arfer; Ymateb Auto heb weinydd cyfnewid, a nodweddion mwy awtomatig ...
  • Rhybudd BCC - dangoswch neges pan geisiwch ateb popeth os yw'ch cyfeiriad post yn rhestr BCC; Atgoffwch Wrth Ymlyniadau ar Goll, a mwy o nodweddion atgoffa ...
  • Ymateb (Pawb) Gyda'r Holl Atodiadau yn y sgwrs bost; Ateb Llawer o E-byst mewn eiliadau; Auto Ychwanegu Cyfarchiad wrth ateb; Ychwanegu Dyddiad i'r pwnc ...
  • Offer Ymlyniad: Rheoli Pob Atodiad ym mhob Post, Datgysylltiad Auto, Cywasgu Pawb, Ail-enwi Pawb, Arbed Pawb ... Adroddiad Cyflym, Cyfrif Postiau Dethol...
  • E-byst Sothach Pwerus yn ôl arfer; Tynnwch y Post a Chysylltiadau Dyblyg... Yn eich galluogi i wneud yn ddoethach, yn gyflymach ac yn well yn Outlook.
tab kutools rhagweld kutools tab 1180x121
kutools rhagweld rhagolygon kutools ynghyd â thab 1180x121
 
Say something here...
symbols left.
You are guest
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Tammy · 2 months ago
    This has saved me so much time! VBA code 1 doesnt save embedded pictures, where as VBA code 2 does but doesnt rename the file with the same name. Is there a way to have VBA code 1 save the attachments and the embedded files and rename/append any that have the same file name? 
    • To post as a guest, your comment is unpublished.
      Tammy · 2 months ago
      Ok, VBA code 1, I just commented out two lines.  LINE 29 and LINE 36   -   LINE 29  LINE 36  'End If
      The VBA code 1 altered for me is as follows.  And saves embedded files and attachments and renames them with a 1,2 etc at the end! 


      Dim GCount As Integer
      Dim GFilepath As String
      Public Sub SaveAttachments()
      'Update 20200821
      Dim xMailItem As Outlook.MailItem
      Dim xAttachments As Outlook.Attachments
      Dim xSelection As Outlook.Selection
      Dim i As Long
      Dim xAttCount As Long
      Dim xFilePath As String, xFolderPath As String, xSaveFiles As String
      On Error Resume Next
      xFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
      Set xSelection = Outlook.Application.ActiveExplorer.Selection
      xFolderPath = xFolderPath & "\Attachments\"
      If VBA.Dir(xFolderPath, vbDirectory) = vbNullString Then
      VBA.MkDir xFolderPath
      End If
      GFilepath = ""
      For Each xMailItem In xSelection
      Set xAttachments = xMailItem.Attachments
      xAttCount = xAttachments.Count
      xSaveFiles = ""
      If xAttCount > 0 Then
      For i = xAttCount To 1 Step -1
      GCount = 0
      xFilePath = xFolderPath & xAttachments.Item(i).FileName
      GFilepath = xFilePath
      xFilePath = FileRename(xFilePath)
      ' If IsEmbeddedAttachment(xAttachments.Item(i)) = False Then
      xAttachments.Item(i).SaveAsFile xFilePath
      If xMailItem.BodyFormat <> olFormatHTML Then
      xSaveFiles = xSaveFiles & vbCrLf & "<Error! Hyperlink reference not valid.>"
      Else
      xSaveFiles = xSaveFiles & "<br>" & "<a href='file://" & xFilePath & "'>" & xFilePath & "</a>"
      End If
      'End If
      Next i
      If xSaveFiles <> "" Then
      If xMailItem.BodyFormat <> olFormatHTML Then
      xMailItem.Body = vbCrLf & "The file(s) were saved to " & xSaveFiles & vbCrLf & xMailItem.Body
      Else
      xMailItem.HTMLBody = "<p>" & "The file(s) were saved to " & xSaveFiles & "</p>" & xMailItem.HTMLBody
      End If
      End If
      xMailItem.Save
      End If
      Next
      Set xAttachments = Nothing
      Set xMailItem = Nothing
      Set xSelection = Nothing
      End Sub

      Function FileRename(FilePath As String) As String
      Dim xPath As String
      Dim xFso As FileSystemObject
      On Error Resume Next
      Set xFso = CreateObject("Scripting.FileSystemObject")
      xPath = FilePath
      FileRename = xPath
      If xFso.FileExists(xPath) Then
      GCount = GCount + 1
      xPath = xFso.GetParentFolderName(GFilepath) & "\" & xFso.GetBaseName(GFilepath) & " " & GCount & "." + xFso.GetExtensionName(GFilepath)
      FileRename = FileRename(xPath)
      End If
      xFso = Nothing
      End Function

      Function IsEmbeddedAttachment(Attach As Attachment)
      Dim xItem As MailItem
      Dim xCid As String
      Dim xID As String
      Dim xHtml As String
      On Error Resume Next
      IsEmbeddedAttachment = False
      Set xItem = Attach.Parent
      If xItem.BodyFormat <> olFormatHTML Then Exit Function
      xCid = ""
      xCid = Attach.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F")
      If xCid <> "" Then
      xHtml = xItem.HTMLBody
      xID = "cid:" & xCid
      If InStr(xHtml, xID) > 0 Then
      IsEmbeddedAttachment = True
      End If
      End If
      End Function
  • To post as a guest, your comment is unpublished.
    Tammy · 2 months ago
    This has saved me so much time! VBA code 1 doesnt save embedded pictures, where as VBA code 2 does but doesnt rename the file with the same name. Is there a way to have VBA code save the attachments and the embedded files? 
  • To post as a guest, your comment is unpublished.
    John · 2 months ago
    hi, if i run it, can the edited email (that shows hyperlink) be seen by the other party on the email?
    afraid of making it awkward
    • To post as a guest, your comment is unpublished.
      Tammy · 2 months ago
      I wondered this also
  • To post as a guest, your comment is unpublished.
    napiwn@gmail.com · 3 months ago
    The Vba 1 code is great. A request to add the date of the email to the file name of the attachment (yyyy-mm-dd ssmm)
  • To post as a guest, your comment is unpublished.
    Steve · 3 months ago
    Is it possible to have a variation on "VBA Code 2: Bulk Save Attachments From Multiple Emails (Check For Duplicates)" where it automatically replaces a duplicate?
  • To post as a guest, your comment is unpublished.
    Compstuff · 7 months ago
    THANK YOU so very much for this script! It has helped me do something I have wanted & needed to do for many years. Are the following modifications still valid for VBA Code 1?

    1)
    This works only if you use the Documents folder. For a more general case:
    delete line 12
    line 15 should read: strFolderpath = "C:\folder\otherfolder\"

    4)
    do not modify the emails in any way (e.g. adding the file save path to the text of the mail), delete line 26-39
  • To post as a guest, your comment is unpublished.
    Alex · 8 months ago
    Hi! I have used code 1 for many times (can't thank You enough for my saved time) and it run smooth. All of a sudden (outlook 2016), without me changing any of settings, it stopped working with message: "The macros in this project are disabled. Please refer to the online help or documentation of the host application to determine how to enable macros." I have tried changing settings in Outlook but none of available options gave result (Trust center settings / Macros)
    • To post as a guest, your comment is unpublished.
      crystal · 8 months ago
      Hi Alex,
      It seems that macros are disabled in Outlook. Please follow the steps as the below screenshot shown to enable all macros, and then restart Outlook.

  • To post as a guest, your comment is unpublished.
    Stephen · 8 months ago
    It's okay I found the necessary tool to save attachments.
  • To post as a guest, your comment is unpublished.
    Stephen · 8 months ago
    I install Kutools and now I can't run any other macros including this one. I really need to save a whole heap of attachment, but Kutools let's you save emails but it doesn't save attachments too.
  • To post as a guest, your comment is unpublished.
    Tara · 10 months ago
    Hello,

    I am having issues with the area

    Function FileRename(xFilePath As String) As String
    Dim xPath As String
    Dim xFso As FileSystemObject

    I am getting a Complie error: User-defined tyoe not defined.
    • To post as a guest, your comment is unpublished.
      crystal · 10 months ago
      Hi,
      Before running the code, please click Tools > References, and then check the Microsoft Scripting Runtime box in the References - Project dialog box.
  • To post as a guest, your comment is unpublished.
    John · 1 years ago
    Thank you, but only works if the attachments each have different names. For same name attachments, it will just overwrite the previous file. So I edited this VBA script to prefix each file saved with a number:


    Public Sub SaveAttachments()
    'Update 20191101
    Dim objOL As Outlook.Application
    Dim objMsg As Outlook.MailItem
    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
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    Set objOL = CreateObject("Outlook.Application")
    Set objSelection = objOL.ActiveExplorer.Selection
    strFolderpath = strFolderpath & "\Attachments\"
    Dim i2 As Long
    i2 = 0
    For Each objMsg In objSelection
    i2 = i2 + 1
    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count
    strDeletedFiles = ""
    If lngCount > 0 Then
    For i = lngCount To 1 Step -1
    strFile = objAttachments.Item(i).FileName
    strFile = strFolderpath & CStr(i2) & "_" & strFile
    objAttachments.Item(i).SaveAsFile strFile
    'objAttachments.Item(i).Delete()
    If objMsg.BodyFormat <> olFormatHTML Then
    strDeletedFiles = strDeletedFiles & vbCrLf & "!>
  • To post as a guest, your comment is unpublished.
    Calpa · 1 years ago
    Works great! if files have different namnes, as stated in earlier comment, I know my files will have same name, can you adjust the code anyway so that it works with same name files? Maybe adding time stamp to the file name? or just digits 1, 2, 3 etc (But not digits after filetype code, eg. ".csv 1"...) Thanks alot!!
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hi Calpa,
      The code has been updated. For solving your problem, please apply the VBA code 1 in the tutorial.
  • To post as a guest, your comment is unpublished.
    Carl · 1 years ago
    First code worked well, but my attachments have exact same name, can I save all of them in some way? Thanks!
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hi Carl,
      The code has been updated. For solving your problem, please apply the VBA code 1 in the tutorial.
  • To post as a guest, your comment is unpublished.
    Adam · 1 years ago
    Is it possible to name the files based off the subject line. You know how you can edit the subject line from received emails i organize my emails by customer name and date. Can I have the script use the subject line as the file name?
  • To post as a guest, your comment is unpublished.
    Paul · 1 years ago
    You are a golden God. Thank you!
  • To post as a guest, your comment is unpublished.
    BB · 1 years ago
    OMG thank you!!!! The VBA code worked! Just saved me HOURS of work and saved my sanity!
  • To post as a guest, your comment is unpublished.
    Alan · 1 years ago
    VBA code works great but it doesn't check for duplicate filenames - just overwrites them. Can that be added?

    ALan
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hi Alan,
      The code I replied to you before has some problems. I have added new codes to the tutorial, and the problem you mentioned have been solved. Please have a look and try it. Thank you!
  • To post as a guest, your comment is unpublished.
    Mike · 1 years ago
    The VBA code worked GREAT! Thanks.
  • To post as a guest, your comment is unpublished.
    outlookuser · 1 years ago
    Thank you! really help me a lot!!
  • To post as a guest, your comment is unpublished.
    Priyanka · 1 years ago
    I have applied this VBA to few mails. How to undo this? I dont want those messages in all mails (The file(s) were saved to .....). Please help.
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hi Priyanka,
      The VBA code does not support Undo operation. Sorry for the inconvenience.
  • To post as a guest, your comment is unpublished.
    Hiep · 2 years ago
    Thank you. It saves me lots of time.
  • To post as a guest, your comment is unpublished.
    BG Davis · 2 years ago
    So I click the link "Kutools for outlook" and I'm directed to a page that is not that, but "Kutools - Combines More Than 300 Advanced Functions and Tools for Microsoft Excel."

    Nothing about Outlook. Waste of time.
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Hi Davis,
      We created an incorrect hyperlink. Thanks for your reminder! And sorry for the inconvenience brought to you.
  • To post as a guest, your comment is unpublished.
    Brian · 4 years ago
    This is what the code is at now, and it does save all the attachments, but it only adds text to the first message. Can anyone help me with this?

    Public Sub SaveAttachments()
    'Update 20170523
    Dim objOL As Outlook.Application
    Dim objMsg As Outlook.MailItem
    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
    Set objOL = CreateObject("Outlook.Application")
    Set objSelection = objOL.ActiveExplorer.Selection
    strFolderpath = "C:\Users\brianp\Documents\Attachments\"
    For Each objMsg In objSelection
    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count
    'Use this to test MsgBox "Subject = " & objMsg.Subject & " lngCount = " & objAttachments.Count
    If lngCount > 0 Then
    For I = lngCount To 1 Step -1
    strFile = objAttachments.Item(I).FileName
    strFile = strFolderpath & strFile
    objAttachments.Item(I).SaveAsFile strFile
    Next I
    End If
    If objMsg.BodyFormat olFormatHTML Then
    objMsg.Body = vbCrLf & "The Attached file(s) were saved to " & "" & strFile & "" & vbCrLf & objMsg.Body
    Else
    objMsg.HTMLBody = "" & "The Attached file(s) were saved to " & "" & strFile & "" & "" & objMsg.HTMLBody
    End If
    Next
    ExitSub:
    Set objAttachments = Nothing
    Set objMsg = Nothing
    Set objSelection = Nothing
    Set objOL = Nothing
    End Sub
  • To post as a guest, your comment is unpublished.
    Brian · 4 years ago
    I can get this to run but how and the objSelection.Count is 2 but it will only save the attachments on the first email.
  • To post as a guest, your comment is unpublished.
    Atron Seige · 4 years ago
    Thanks! This saved me a lot of time and frustration!
  • To post as a guest, your comment is unpublished.
    Josh Fernandez · 4 years ago
    Works great with no problems! Thanks. Saved me a bunch of time!

    Thanks,

    Josh
  • To post as a guest, your comment is unpublished.
    Sathish · 5 years ago
    How to remove the "The file(s) were saved to" which is showing below.....
    • To post as a guest, your comment is unpublished.
      mallary.webb · 6 months ago
      I just adjusted the code after "Next i" and it worked fine:
      Next i
      If xSaveFiles <> "" Then
      If xMailItem.BodyFormat <> olFormatHTML Then

      Else

      End If
  • To post as a guest, your comment is unpublished.
    debsdebsdebs · 6 years ago
    This worked great except for one problem. The attachments in my emails are all named the same thing, so when they copy over, the script keeps replacing the same file with the next attachment in the queue. Is there any way to make it rename them rather than rewrite them?

    Thanks!
  • To post as a guest, your comment is unpublished.
    tweazee · 7 years ago
    To sharon -- The below website fixes your issue.

    www_dot_outlook-tips_dot_net/code-samples/save-and-delete-attachments/

    It does NOT have the timestamp feature code that TXgardner provided above, so if you want that, you have to edit your code.
  • To post as a guest, your comment is unpublished.
    sharon · 7 years ago
    Hi..I tried everything on here but I keep getting Complile Error block if without end if. I made adjustments per Thomas' suggestions. Heres the code..what am I missing? Any help is appreciated.
    Public Sub SaveAttachments()
    'Update 20130828
    Dim objOL As Outlook.Application
    Dim objMsg As Outlook.MailItem
    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
    objOL = CreateObject("Outlook.Application")
    objSelection = objOL.ActiveExplorer.Selection
    strFolderpath = "C:\folder\Attachments\"
    For Each objMsg In objSelection
    objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count
    strDeletedFiles = ""
    If lngCount > 0 Then
    For i = lngCount To 1 Step -1
    strFile = objAttachments.Item(i).FileName
    strFile = strFolderpath & strFile
    objAttachments.Item(i).SaveAsFile strFile
    DoEvents
    'objAttachments.Item(i).Delete()
    Next
    ExitSub:
    objAttachments = Nothing
    objMsg = Nothing
    Set objSelection = objOL.ActiveExplorer.Selection
    objOL = Nothing
    End Sub
  • To post as a guest, your comment is unpublished.
    TXgardener · 7 years ago
    Following on the suggestions above, I had daily system generated emails with attached 'report.txt' and needed to append the sent date to the saved file name in order to avoid overwrites and to distinguish files. Made the following adds in the appropriate places:
    add- Dim strSent As String
    add- strSent = Format(objMsg.SentOn, "yymmdd")
    add- strFile = strSent & strFile

    Saved files are now 140822Report.txt, etc.
  • To post as a guest, your comment is unpublished.
    Thomas · 7 years ago
    Thanks for sharing.

    I agree with Stephan on his first two points, see some clarification on his point 3. Finally, adding a DoEvents at the right place should allow you to process large number of emails (just run this code on 157 mails in Outlook 2013).

    Some additional thoughts:

    1)
    This works only if you use the Documents folder. For a more general case:
    delete line 12
    line 15 should read: strFolderpath = "C:\folder\otherfolder\"

    substitute [i]C:\folder\otherfolder\[/i] with whatever path you have.

    2)
    This code will not delete the attachments, if you want that just delete the leading ' from line 25.

    3)
    If you have big attachments, then probably it is a good idea (as Stephan noted) to put a DoEvents function after line 24.

    4)
    I personally do not want to modify the emails in any way (e.g. adding the file save path to the text of the mail), if you agree with me then you can delete line 26-39.

    5)
    If you skip my step 4, then you can allow the program to modify the emails by checking "Allow access for x time", then you have to click allow only once (c.f. step 6 above in the original).
  • To post as a guest, your comment is unpublished.
    Stephan · 7 years ago
    Some corrections:

    1. objMsg.Save 'without ()
    2. Objects must be assigned with SET (e. g. SET objSelection = objOL.ActiveExplorer.Selection)

    3. The main Loop should contain a DoEvents in order to prevent blankout by Outlook.

    4. When processing a lot of mails (more than 100), Outlook may Crash. It seems that there is a Memory leak somewhere.

    Just my 2 Cents.

    Apart from the bugs (probably due to Outlook 2013) this is really nice and working. Thanks a lot for sharing.
  • To post as a guest, your comment is unpublished.
    Alain · 7 years ago
    Same problem syntax error on objMsg.Save() ...
  • To post as a guest, your comment is unpublished.
    Valencia · 7 years ago
    When I try to run this I get syntax error on objMsg.Save() - expects =
  • To post as a guest, your comment is unpublished.
    Chris · 7 years ago
    When I try to run this I get syntax error on objMsg.Save() - expects =