https://teratail.com/questions/30215
上記サイトを参考にOUTlookのVBAに以下を記述しました。
記載の通り、添付ファイルの保存に成功!
あとはExcelシートのセルに添付ファイル(csv)の中身を埋めていきたいですが実現可能でしょうか。やり方をご教示願います。Outlook VBAからExcel VBAを起動するのでしょうか
' メール受信時に発生するイベント
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim i As Integer
Dim c As Integer
Dim colID As Variant
'
If Instr(EntryIDCollection, ",") = 0 Then
SaveAttachments EntryIDCollection
Else
colID = Split(EntryIDCollection, ",")
For i = LBound(colID) To UBound(colID)
SaveAttachments colID(i)
Next
End If
End Sub
'
' 添付ファイルの保存を行うサブ プロシージャ
Private Sub SaveAttachments(ByVal strEntryID As String)
Const SAVE_PATH = "C:\attachments"
Dim objFSO As Object ' FileSystemObject
Dim objMsg As Object
Dim objAttach As Attachment
Dim strFileName As String
Dim c As Integer: c = 1
Set objFSO = CreateObject("Scripting.FileSystemObject") Set objMsg = Application.Session.GetItemFromID(strEntryID)
'
' ここで条件指定
'
For Each objAttach In objMsg.Attachments
With objAttach
strFileName = SAVE_PATH & objAttach.FileName While objFSO.FileExists(strFileName) strFileName = SAVE_PATH & Left(.FileName, InStrRev(.FileName, ".") - 1) _ & "-" & c & Mid(.FileName, InStrRev(.FileName, ".")) c = c + 1 Wend .SaveAsFile strFileName End With Next Set objMsg = Nothing Set objFSO = Nothing
End Sub
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。