0

フォルダ内のすべての電子メールの添付ファイルをローカル マシンまたはネットワーク上の選択した場所に保存し、電子メールから添付ファイルを削除して、電子メールの本文にハイパーリンクを残して、ドキュメントが配置されています。

そんなマクロを見つけました。ただし、時々、エラー 13 の「型の不一致」が発生し、デバッガーを開くと、強調表示されるのはマクロの一番下にある「次へ」ステートメントだけです。

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='file://" & 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
4

1 に答える 1

0

コレクションには、会議出席依頼など、MAPIFolder.Items以外のオブジェクト タイプを含めることができます。MailItem

処理する前に項目のタイプを確認するように変更した場合:

Dim itm as Object

For Each itm In olPurgeFolder.Items

    If TypeOf itm Is MailItem Then

        Set msg = itm

        ' rest of code
于 2013-08-20T09:02:30.420 に答える