Penghapusan Lampiran Outlook dengan Hyperlink ke Lokasi

Saya ingin menyimpan lampiran pada semua email dalam folder ke lokasi yang dipilih di mesin atau jaringan lokal, menghapus lampiran dari email, dan kemudian meninggalkan hyperlink di badan email yang menunjukkan di mana dokumen-dokumen tersebut berada.

Saya telah menemukan makro seperti itu. NAMUN, dari waktu ke waktu, saya mendapatkan kesalahan 13 "ketik ketidakcocokan" dan ketika saya membuka debugger, satu-satunya hal yang disorot adalah pernyataan "Berikutnya" di bagian paling bawah makro.

Public Sub SaveOLFolderAttachments()

' Ask the user to select an Outlook folder to process
Dim olPurgeFolder As Outlook.MAPIFolder
Set olPurgeFolder = Outlook.GetNamespace("MAPI").PickFolder
If olPurgeFolder Is Nothing Then Exit Sub

' Ask the user to select a file system folder for saving the attachments
Dim oShell As Object
Set oShell = CreateObject("Shell.Application")
Dim fsSaveFolder As Object
Set fsSaveFolder = oShell.BrowseForFolder(0, "Please Select a Save Folder:", 1)
If fsSaveFolder Is Nothing Then Exit Sub
' Note:  BrowseForFolder doesn't add a trailing slash

' Iteration variables
Dim msg As Outlook.MailItem
Dim att As Outlook.Attachment
Dim sSavePathFS As String
Dim sDelAtts As String

For Each msg In olPurgeFolder.Items

sDelAtts = ""

' We check each msg for attachments as opposed to using .Restrict("[Attachment] > 0")
' on our olPurgeFolder.Items collection.  The collection returned by the Restrict method
' will be dynamically updated each time we remove an attachment.  Each update will
' reindex the collection.  As a result, it does not provide a reliable means for iteration.
' This is why the For Each loops will not work.
If msg.Attachments.Count > 0 Then

  ' This While loop is controlled via the .Delete method
  ' which will decrement msg.Attachments.Count by one each time.
  While msg.Attachments.Count > 0

    ' Save the file
    sSavePathFS = fsSaveFolder.Self.Path & "\" & msg.Attachments(1).FileName
    msg.Attachments(1).SaveAsFile sSavePathFS

    ' Build up a string to denote the file system save path(s)
    ' Format the string according to the msg.BodyFormat.
    If msg.BodyFormat <> olFormatHTML Then
        sDelAtts = sDelAtts & vbCrLf & "<file://" & sSavePathFS & ">"
    Else
        sDelAtts = sDelAtts & "<br>" & "<a href='/idfile://" & sSavePathFS & "'>" & sSavePathFS & "</a>"
    End If

    ' Delete the current attachment.  We use a "1" here instead of an "i"
    ' because the .Delete method will shrink the size of the msg.Attachments
    ' collection for us.  Use some well placed Debug.Print statements to see
    ' the behavior.
    msg.Attachments(1).Delete

  Wend

  ' Modify the body of the msg to show the file system location of
  ' the deleted attachments.
  If msg.BodyFormat <> olFormatHTML Then
    msg.Body = msg.Body & vbCrLf & vbCrLf & "Attachments Deleted:  " & Date & " " & Time & vbCrLf & vbCrLf & "Saved To:  " & vbCrLf & sDelAtts
  Else
    msg.HTMLBody = msg.HTMLBody & "<p></p><p>" & "Attachments Deleted:  " & Date & " " & Time & vbCrLf & vbCrLf & "Saved To:  " & vbCrLf & sDelAtts & "</p>"
  End If

  ' Save the edits to the msg.  If you forget this line, the attachments will not be deleted.
  msg.Save

End If

Next

End Sub