VBSでファイルを指定のフォルダに保存

現在、下記コードでメールに添付されている添付ファイルを
保存するという事を行っておりますが
下記コードですと、現在メールが保管されているフォルダと同じ
階層に添付ファイルが保存されます。
これを自分で指定したフォルダに保存するようにするには
どのようなコードにすればよいでしょうか？

' 許可されている拡張子
Set AllowedExtensions = CreateObject("Scripting.Dictionary")
AllowedExtensions.Add "msg" , 0

Set args = WScript.Arguments

' 引数のチェック。対象ファイル以外が混ざっている場合終了。
set fobj = CreateObject("Scripting.FileSystemObject")
For Each arg In args
ext = fobj.GetextensionName(arg)
if not AllowedExtensions.Exists(ext) then
msgbox "msgファイル以外が指定されました。終了します。"
WScript.Quit
end if
Next
Set appOL = CreateObject("Outlook.Application")
For Each path In args
Set msg = appOL.CreateItemFromTemplate(path)
for each atc in msg.Attachments
atc.SaveAsFile path & "." & atc.DisplayName
next
Next

'File path & "." & atc.DisplayName

msgbox "抽出完了しました。"

No.1 ベストアンサー 回答者： Qchan1962 回答日時： 2019/09/24 02:49

急いでたようですが、

こんな感じでは？
ご質問のVBScriptコードに手を加えました。

Set AllowedExtensions = CreateObject("Scripting.Dictionary")
AllowedExtensions.Add "msg", 0
Set args = WScript.Arguments
' 引数のチェック。対象ファイル以外が混ざっている場合終了。
Set fobj = CreateObject("Scripting.FileSystemObject")
　For Each arg In args
　　ext = fobj.GetExtensionName(arg)
　　If Not AllowedExtensions.Exists(ext) Then
　　　MsgBox "msgファイル以外が指定されました。終了します。"
　　　WScript.Quit
　　End If
　Next

Const SaveFolderPath = "C:\TEST\"　’追加、保存先アドレス。ここを変更してください。最後の￥忘れずに
Set appOL = CreateObject("Outlook.Application")
　For Each Path In args
　　Set msg = appOL.CreateItemFromTemplate(Path)
　　　For Each atc In msg.Attachments
　　　　atc.SaveAsFile SaveFolderPath & atc.Filename　’ここを変更しました
　　　Next
　Next

MsgBox "抽出完了しました。"

この回答へのお礼

ありがとうございます。

頂いたコードで目的が果たせました。
大変助かりました。
ありがとうございました。

お礼日時：2019/09/24 17:36