0

お世話になります。フォルダー内のメールのうちZIPファイルのみを指定し保存、EXCELに書き出したいと思います。

Attachements.Countに”*.ZIP”を組み込みたいと思います。何故ならテスト用の6つのメールのうち5つのメールのZIPファイルは正常に保存されますが、1つのメールに添付されていますZIPファイルのみが拡張子が付かず空のまま保存されてしまいますため、安全策として拡張子を指定したいと考えています。宜しくお願い致します。

Sub SaveAttachmentFiles()
Dim myNamespace As Namespace
Dim myInbox As Object
Dim mySubfolder As Object
Dim strPath As String
Dim strFile As String
Dim objItem As Object
Dim i As Long

Set myNamespace = GetNamespace("MAPI") 'Messeging Application Programming Interface
Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox)
Set mySubfolder = myInbox.Folders.Item("運用報告書").Folders.Item("★ZIP★")

strPath = "C:\Users\atsuko-himaki\Desktop\データ振り分け\ZIP\" '添付ファイルを保存したいフォルダ

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

Dim file As String
Dim ii As Integer
Dim LastRow As Integer

file = Dir("C:\Users\atsuko-himaki\Desktop\データ振り分け\ZIP\")

Worksheets("zip").Select
LastRow = Range("b" & Rows.Count).End(xlUp).Row + 1
ii = LastRow
Do While file <> ""
Worksheets("zip").Cells(ii, 2).Value = file
file = Dir()
ii = ii + 1
Loop
Range("b" & LastRow).Select
With Selection
.Interior.ColorIndex = 19
.Font.ColorIndex = 5
.Font.Bold = True
End With

Worksheets("ZIP処理").Activate
Range("a1").Select
End Sub

この質問は解決済みのためクローズされています。
IloveF1 ベストアンサーとして選択しました
回答とコメントは、会員登録(無料)で閲覧できるようになります。