【お知らせ】カテゴリの見直しについて

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

' 許可されている拡張子
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 "抽出完了しました。"

A 回答 (1件)

急いでたようですが、


こんな感じでは?
ご質問の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 "抽出完了しました。"
    • good
    • 0
この回答へのお礼

ありがとうございます。

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

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

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング