Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2019)
Outlookメール添付ファイルをPCフォルダに連番を付けて保存
投稿日時: 22/07/13 16:38:24
投稿者: ふく@たろう

下記マクロでoutlookの添付ファイルをPCフォルダに保存できたのですが、
同一ファイル名が上書きされてしまいます。
outlookからPCフォルダに保存するタイミングで連番を付けるvbsが解りましたら教えてください。
何卒、宜しくお願いします。
 
Option Explicit
 
Sub SaveAttachmentFiles01()
Dim myNamespace As Namespace
Dim myinbox As Object, myFolder As Object, objItem As Object
Dim strSavePath As String, strFile, i As Long, numStartDate As Long
 
numStartDate = ThisWorkbook.ActiveSheet.Cells(1, 1)
 
strSavePath = ThisWorkbook.Path & "\日報"
Set myNamespace = GetNamespace("MAPI")
Set myinbox = myNamespace.GetDefaultFolder(olFolderInbox)
Set myFolder = myinbox.Folders.Item("報告").Folders.Item("01_日報")
 
For Each objItem In myFolder.Items
With objItem
  If .SentOn >= numStartDate Then
      For i = 1 To .Attachments.Count
      If .Attachments.Item(i) Like "日報.xlsx" Then
          strFile = strSavePath & "\" & Left(.Attachments.Item(i), Len(.Attachments.Item(i)) - 5) & Format(.SentOn, "yyyymmdd") & ".xlsx"
                                                         
          .Attachments.Item(i).SaveAsFile strFile
          End If
        Next i
      End If
      End With
Next objItem
 
     MsgBox "Outlookからの取得完了", vbInformation
      
End Sub
 

回答
投稿日時: 22/07/14 12:37:07
投稿者: simple

モデル的なコードを示します。
(あなたの状況にまるまる適用できるコードを示すつもりはありませんので、注意下さい)
これを参考にして、そちらで応用してみてください。

    sToday = Format(Date, "yyyymmdd")
    Do
        k = k + 1
        f = sToday & Format(k, "_00 ")  
        fname = f & "*.xlsm"
        If Dir(fname) = "" Then     '実際にはパス指定にする必要があります。
            'fnameというファイル名で保存するコードをここに書きます。
            Exit Do
        End If
    Loop

質問を拝見すると、コード以前に以下のようなことが思い浮かびます。
・日報を送ってくるのはひとつの組織だけですか?
・そうであれば、日付で一意になるので、連番は不要ではないですか?
・もし一日に複数あるのが頻出するのであれば、時刻までファイル名にいれればよいのでは?
・複数の組織から送られてくるのであれば、組織を識別するファイル名に入れる必要があるのでは?
・連番と言ってもいろいろあります。桁数とか。日付に単に続けていいのか、等々。
# 回答は特に求めません。
# できれば、こうしたことを質問文に予め反映していただけるとよいでしょう。

投稿日時: 22/07/14 13:07:54
投稿者: ふく@たろう

回答有難うございます。同一日付はありますが、時間を入れることにより
上書きを回避できそうです。アドバイス有難うございました。