Outlook (全般)

Outlook 全般に関するフォーラムです。
Outlook Express、Windowsメールも含みます。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10 Pro : Outlook 2016)
添付ファイルを自動保存するマクロ
投稿日時: 21/02/22 14:30:20
投稿者: kei-matsumoto

特定のフォルダに入っているメールの添付ファイルを自動で保存するマクロについてですが
 
下記のように議事録に入っているフォルダを保存するようにしたいのですが
同じ名前の添付ファイルがある場合は自動で上書き保存されてしまうため、一番上のものに関しては、数字をファイル名の頭につけようとしておりますが、うまく行きません。
どこを修正すればよろしいでしょうかご教授頂けますと幸いです。
 
Sub SaveAttachmentFiles()
Dim myNamespace As NameSpace
Dim myInbox As Object
Dim mySubfolder As Object
Dim strPath As String
Dim strFile As String
Dim i As Long
 
Set myNamespace = GetNamespace("MAPI")
 
Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox)
Set mySubfolder = myInbox.Folders.Item("議事録")  
 
strPath = "C:\Users\kei-matsumoto\Desktop\Folder\" '添付ファイルを保存したいフォルダ
 
For Each objItem In mySubfolder.Items
    With objItem
    For i = 1 To .Attachments.Count
 
        strFile = strPath & <<ここに数字を入れたい>>.Attachments.Item(i)
    .Attachments.Item(i).SaveAsFile strFile
 
    Next i
    End With
Next objItem
 
End Sub

回答
投稿日時: 21/02/24 11:32:09
投稿者: Suzu

ファイル名を返す関数の サンプルです。
 
ファイルの先頭に数値との事でしたが、
ファイル名にて、並べ替えを行う際に 判りづらくなるので、
 ファイルベース名 と、拡張子の間に、『_00』形式の数値を入れています。
 
ファイルベース名 / 拡張子 を取得するのに
FSO を使用していますので、参照設定を行ってください。
 
また、メールアイテム複数に対しての様なので、
FSOの変数宣言をモジュールレベルとして、
関数GetFileName内での 変数の 生成/破棄 を行わないようにしています。
 
 

Option Explicit

'要参照設定 Microsoft Scripting RunTime
Dim FSO As Scripting.FileSystemObject

Function GetFileName(strPath) As String
    '引数 : ファイルフルパス
    '戻値 : フォルダ名\ファイルベース名_00.拡張子
    '        00 は、0〜99 まで。 99が存在する場合には、99となる

    Dim i As Long

    Dim strFilePath
    Dim strFolder As String
    Dim strBaseName As String
    Dim strExtensionName As String

    strFilePath = strPath

    If FSO.FileExists(strFilePath) = True Then
        strFolder = FSO.GetParentFolderName(strFilePath)
        strBaseName = FSO.GetBaseName(strFilePath)
        strExtensionName = FSO.GetExtensionName(strFilePath)

        For i = 1 To 1
            strFilePath = (strFolder & "\" & strBaseName & Format(i, "\_00\.") & strExtensionName)
            If FSO.FileExists(strFilePath) = False Then
                Exit For
            End If
        Next
    End If
    GetFileName = strFilePath
End Function

Sub test()
    Set FSO = CreateObject("Scripting.FileSystemObject")

    MsgBox GetFileName("C:\DATA\ファイル名.xls")

    Set FSO = Nothing
End Sub

トピックに返信