아웃룩 첨부파일 저장 시 파일제목

Public Sub 첨부파일_저장()
  Dim coll As VBA.Collection
  Dim obj As Object
  Dim Att As Outlook.attachment
  Dim Sel As Outlook.Selection
  Dim Path$
  Dim i&
  Dim itm As Outlook.MailItem
  Dim SenderName As String
 
 
 
 
 
  Path = "경로"
  Path = Path & Format(Date, "yymmdd") & "\"
  On Error Resume Next
  MkDir Path
  On Error GoTo 0
 
  Set coll = New VBA.Collection
 
  If TypeOf Application.ActiveWindow Is Outlook.Inspector Then
    coll.Add Application.ActiveInspector.CurrentItem
  Else
    Set Sel = Application.ActiveExplorer.Selection
    For i = 1 To Sel.Count
      coll.Add Sel(i)
    Next
  End If
 
  For Each obj In coll
    For Each Att In obj.Attachments
      Att.SaveAsFile Path & " - " & Att.FileName
 
 
    Next
  Next
 
  Shell "Explorer.exe /n, /e, " & Path, vbNormalFocus
End Sub