44

電子メールの添付ファイルを特定のフォルダーに保存し、受信した日付をファイル名に追加する VBA マクロを Outlook で取得しようとしています。

私のグーグルはこれまで私を手に入れました：

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

最初に明らかなことは、受信した時間ではなく現在の時間をファイル名に適用していることですが、変更できないようです。私の理論では、Outlook.Attachment には がなくReceivedTime、電子メール自体を参照する必要があるというものです。

第二に、これはまったく機能していないようです。いじり始めた初日には機能しましたが、その後はファイルの保存を停止しました。

4

6 に答える 6

44

これが私の添付ファイルの保存スクリプトです。添付ファイルを保存するすべてのメッセージを選択すると、そこにコピーが保存されます。また、添付ファイルの保存場所を示すテキストをメッセージ本文に追加します。フォルダー名を簡単に変更して日付を含めることができますが、ファイルの保存を開始する前にフォルダーが存在することを確認する必要があります。

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
于 2013-03-20T18:10:46.693 に答える
7

ReceivedTimeプロパティを参照してください

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

[名前を付けて保存ファイル]\行の最後にもう1つ追加しました。問題になる可能性があります。パス区切り文字を追加する前に、まずテストを実行してください。C:\Temp\

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

設定していないobjAttので「」は不要ですSet objAtt = Nothing。End Subもしあったとしたら、それはループにない直前だったでしょう。

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：いじくり回し始めた最初の日は機能しましたが、その後はファイルの保存を停止しました。

これは通常、セキュリティ設定が原因です。これは、初めてユーザーがマクロを許可してからそれを取り除くための「トラップ」セットです。 http://www.slipstick.com/outlook-developer/how-to-use-outlooks-vba-editor/

于 2013-03-20T18:43:34.547 に答える
2

読み取り可能な日時スタンプを付けて保存するための簡単なコードを追加しました。

sync2pstを使用して、outlook のすべてのデータをすべてのデバイスと同期します。次のように機能します。

  1. ライセンスを 1 つ購入するだけで済みます。pst ファイルをネットワーク上の 1 台のコンピューター (この PC を「サーバー」と呼びましょう) に保存します。
  2. どのデバイスが最初に電子メールをダウンロードしたかに関係なく、「サーバー」上の pst ファイルをすべてのデバイス上のすべての pst ファイルと同期するスケジュールされたタスクを作成します (同期時に開いている pst ファイルをバイパスするには、dos プログラミングの知識が必要です)。 .
  3. すべての添付ファイルを、すべてのデバイスの同じ場所にある同じ skydrive フォルダーに保存します (e:\skydrive\attachments など)。
  4. すべてのデバイスで以下のコードを使用して、添付ファイルを保存します (上記のようにパスを変更します)。

  5. すべてのアカウントに1つのPSTファイルのみを使用し、フォルダー、サブフォルダーなどを作成します...

  6. VBA の場合: microsoft scripting runtime「extra/references...」を参照してください

  7. ここにコードがあります

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
于 2013-06-14T11:21:50.507 に答える