いつもお世話になっております。

プチライブラリ「Outlook操作(条件を指定して対象メール保存(日時指定形式))」について、スクリプトのカスタマイズの質問です。

'--------------------------------------------------------------------
' メール保存先フォルダを作成
'--------------------------------------------------------------------
Function MakeSavePath(objFSO, sBasePath, receivedTime)
'SRetPathからsBasePathへ変更
MakeSavePath = sBasePath
End Function

上記のように、フォルダの区分けをせず、直下のフォルダに添付ファイルを保存するようにスクリプトをカスタマイズしましたが、

保存する添付ファイルが、全て同じ名前になっているため、「既に同じファイル名の添付ファイルが存在します。」という

エラーになってしまいます。

'--------------------------------------------------------------------
'メールと添付ファイルを保存
'--------------------------------------------------------------------
Sub SaveMailAndFile(oFS, oMail, sSavePath)
Dim oAttachments
Dim sMsgFileName
Dim i

Set oAttachments = oMail.Attachments

sMsgFileName = sSavePath & "\" & ReplaceSubjectToFileName(oMail.Subject) & ".msg"

On Error Resume Next
oMail.SaveAs sMsgFileName, olMSG
If Err.Number <> 0 Then
On Error GoTo 0
Err.Raise 1, "", "メールの保存に失敗しました。" & vbCrLf & "[" & sMsgFileName & "]"
' WScript.Quit()
End If

On Error GoTo 0
For i = 1 To oAttachments.count
If oFS.FileExists(sSavePath & "\" & oAttachments(i).Filename) = False Then
On Error Resume Next
oAttachments(i).SaveAsFile (sSavePath & "\" & oAttachments(i).Filename)
If Err.Number <> 0 Then
On Error GoTo 0
Err.Raise 1, "", "添付ファイルの保存に失敗しました。" & vbCrLf & "[" & sSavePath & "\" & oAttachments(i).Filename & "]"
' WScript.Quit()
End If

On Error GoTo 0
Else
Err.Raise 1, "", "既に同じファイル名の添付ファイルが存在します。"
' WScript.Quit()
End If
Next

End Sub

おそらくこのスクリプトの、どこかを変更すれば可能だと思うのですが、どう変更すればいいかわかりません。

ご教授頂けないでしょうか。

又、本文の保存はせずに、添付ファイルのみ保存したいので、その部分もスクリプトの変更で可能であれば、ご教授頂ければ幸いです。

宜しくお願い致します。