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

Attachements.Countに”*.ZIP”を組み込みたいと思います。何故ならテスト用の６つのメールのうち５つのメールのZIPファイルは正常に保存されますが、１つのメールに添付されています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