みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

VBScriptでの「名前をつけて保存」の使用

【環境】Windows10,Outlook2016

【ご教示いただきたい点】
以下は、OutlookでのビューをエクスポートするVBScriptですが、エクスポート先のファイル名 についてVBScript内に記述するのではなく、「名前をつけて保存」のダイアログを表示させて、任意のフォルダを選択した後、任意のファイル名を入力して、「保存」ボタンを押すと、指定したファイルに対してOutlookでのビューをエクスポートさせるようにするにさせたいと考えていますがどのように修正をしたらよいでしょうか。

--
Const VIEW_XML = "D:\OUTLOOK_BACKUP\current.view" ' エクスポート先のファイル名
Dim olkApp
Dim objFSO
Dim curView
Dim stmXml
Dim strXml
Set olkApp = CreateObject("Outlook.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set curView = olkApp.ActiveExplorer.CurrentFolder.CurrentView
strXml = curView.XML
Set stmXml = objFSO.CreateTextFile(VIEW_XML)
' 1 行目はビューの名前と種類
stmXml.WriteLine curView.Name & vbTab & curView.ViewType
stmXml.Write strXml
stmXml.Close
--

投稿日時 - 2019-01-31 21:55:57

QNo.9583339

困ってます

質問者が選んだベストアンサー

>OutlookでのビューをエクスポートするVBScriptにおいて、「名前をつけて保存」のダイアログを表示して、任意のフォルダに任意のファイル名で保存する方法についてはよくわかりませんでした。

Excelのダイアログを利用すれば如何でしょうか
>Const VIEW_XML = "D:\OUTLOOK_BACKUP\current.view"
の代わりに
Dim objExcel, VIEW_XML
Set objExcel = CreateObject("Excel.Application")
VIEW_XML = objExcel.GetSaveAsFilename("", "viewファイル,*.view")
objExcel.Quit
Set objExcel = Nothing
If VIEW_XML = False Then
  MsgBox "キャンセルしました。"
  WScript.Quit
End If

投稿日時 - 2019-02-04 12:19:07

補足

ありがとうございます。

あれから、調べて「フォルダ参照」を表示してエクスポート先のフォルダが参照できるように修正はしましたが、ファイル名を指定するまでには至っていないため、ご教示いただいた方法を試してみたいと思います。


On Error Resume Next
Const VIEW_XML_FILE = "current.view" ' エクスポート先のファイル名
Dim olkApp
Dim objShell
Dim objFolder
Dim objFSO
Dim curView
Dim stmXml
Dim strViewXmlFolder
Dim strXml
Set objShell = CreateObject("Shell.Application")
'フォルダ選択ダイアログを表示
Set objFolder = objShell.BrowseForFolder(0, "フォルダを選択してください", 0)
Set olkApp = CreateObject("Outlook.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set curView = olkApp.ActiveExplorer.CurrentFolder.CurrentView
strXml = curView.XML
strViewXmlFolder = objFolder.items.Item.Path
Set stmXml = objFSO.CreateTextFile(strViewXmlFolder & "\" & VIEW_XML_FILE)
' 1 行目はビューの名前と種類
stmXml.WriteLine curView.Name & vbTab & curView.ViewType
stmXml.Write strXml
stmXml.Close

投稿日時 - 2019-02-04 22:02:05

お礼

ありがとうございます。

ご教示いただいた方法で行うことができました。

Dim objExcel
Dim VIEW_XML
Dim olkApp
Dim objFSO
Dim curView
Dim stmXml
Dim strXml
Set objExcel = CreateObject("Excel.Application")
VIEW_XML = objExcel.GetSaveAsFilename("", "viewファイル,*.view")
objExcel.Quit
Set objExcel = Nothing
If VIEW_XML = False Then
MsgBox "キャンセルしました。"
Wscript.Quit
End If
Set olkApp = CreateObject("Outlook.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set curView = olkApp.ActiveExplorer.CurrentFolder.CurrentView
strXml = curView.XML
Set stmXml = objFSO.CreateTextFile(VIEW_XML)
' 1 行目はビューの名前と種類
stmXml.WriteLine curView.Name & vbTab & curView.ViewType
stmXml.Write strXml
stmXml.Close

投稿日時 - 2019-02-04 23:02:27

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.4

VIEW_XML = objExcel.GetSaveAsFilename(""D:\OUTLOOK_BACKUP\current.view" ", "viewファイル,*.view")
なども試されては

投稿日時 - 2019-02-04 23:02:50

お礼

ありがとうございます。

以下にしてみましたが、VIEW_XML = objExcel.GetSaveAsFilename(""D:\OUTLOOK_BACKUP\current.view" ", "viewファイル,*.view")の行において、なぜか「エラー:')'がありません。 コード:800A03EE」になりました。

Dim objExcel
Dim VIEW_XML
Dim olkApp
Dim objFSO
Dim curView
Dim stmXml
Dim strXml
Set objExcel = CreateObject("Excel.Application")
VIEW_XML = objExcel.GetSaveAsFilename(""D:\OUTLOOK_BACKUP\current.view" ", "viewファイル,*.view")
objExcel.Quit
Set objExcel = Nothing
If VIEW_XML = False Then
MsgBox "キャンセルしました。"
Wscript.Quit
End If
Set olkApp = CreateObject("Outlook.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set curView = olkApp.ActiveExplorer.CurrentFolder.CurrentView
strXml = curView.XML
Set stmXml = objFSO.CreateTextFile(VIEW_XML)
' 1 行目はビューの名前と種類
stmXml.WriteLine curView.Name & vbTab & curView.ViewType
stmXml.Write strXml
stmXml.Close

投稿日時 - 2019-02-07 13:39:49

ANo.3

>VIEW_XML = objExcel.GetSaveAsFilename("", "viewファイル,*.view")
   ↓ では
VIEW_XML = objExcel.GetSaveAsFilename("D:\OUTLOOK_BACKUP\
", "viewファイル,*.view")

投稿日時 - 2019-02-04 22:59:59

お礼

ありがとうございます。

以下で、「名前を付けて保存」でフォルダ「D:\OUTLOOK_BACKUP」が選択されている状態で任意のファイル名で保存することができました。

Dim objExcel
Dim VIEW_XML
Dim olkApp
Dim objFSO
Dim curView
Dim stmXml
Dim strXml
Set objExcel = CreateObject("Excel.Application")
VIEW_XML = objExcel.GetSaveAsFilename("D:\OUTLOOK_BACKUP\","viewファイル,*.view")
objExcel.Quit
Set objExcel = Nothing
If VIEW_XML = False Then
MsgBox "キャンセルしました。"
Wscript.Quit
End If
Set olkApp = CreateObject("Outlook.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set curView = olkApp.ActiveExplorer.CurrentFolder.CurrentView
strXml = curView.XML
Set stmXml = objFSO.CreateTextFile(VIEW_XML)
' 1 行目はビューの名前と種類
stmXml.WriteLine curView.Name & vbTab & curView.ViewType
stmXml.Write strXml
stmXml.Close

投稿日時 - 2019-02-07 13:54:20

ANo.1

すみません>< 回答じゃないんですが・・・
貴殿が望まれる答えが返るまで、下記サイト読んでみて下さい
色々使えそうなのがありますよっ
https://outlooklab.wordpress.com/category/outlook-vba-%E3%83%9E%E3%82%AF%E3%83%AD/outlook-2016-%E3%83%9E%E3%82%AF%E3%83%AD/page/7/

『OUTLOOK 2016 マクロ』集みたいなのです

投稿日時 - 2019-02-01 10:19:51

お礼

ありがとうございます。

記載したOutlookでのビューをエクスポートするVBScriptについて、ご紹介いただきましたサイトの情報を拝見しました。
VBScript内でエクスポートするファイル名をしているため、「名前をつけて保存」のダイアログを表示して、任意のフォルダに任意のファイル名で保存できないかと考えており、質問させていただきました。

OutlookでのビューをエクスポートするVBScriptで出力したファイルをインポートするVBScriptを変更して「アップロードするファイルの選択」のダイアログを表示して、フォルダとファイルを指定できるように修正を行いました。
しかし、OutlookでのビューをエクスポートするVBScriptにおいて、「名前をつけて保存」のダイアログを表示して、任意のフォルダに任意のファイル名で保存する方法についてはよくわかりませんでした。

元々はご紹介いただいたサイトのVBScriptの修正のため、サイトで確認してみることにします。


On Error Resume Next
Dim olkApp
Dim objFSO
Dim stmXml
Dim stmXml2
Dim strLine
Dim arrLine
Dim colViews
Dim curView
Dim objVIEW_XML
With CreateObject("InternetExplorer.Application")
.Visible = False
.FullScreen = True
.Navigate "about:blank"

'表示待ち
While .Busy Or .readyState <> 4
WScript.Sleep 100
Wend

Set objVIEW_XML = .document.createElement("input")
objVIEW_XML.setAttribute "type", "file"
.document.body.appendChild objVIEW_XML
objVIEW_XML.Click
If Trim(Len(objVIEW_XML.Value)) > 0 Then
objVIEW_XML.Focus
.ExecWB 17, 0 'OLECMDID_SELECTALL
.ExecWB 12, 0 'OLECMDID_COPY
stmXml = CreateObject("htmlfile").parentWindow.clipboardData.GetData("text")
End If
Set objVIEW_XML = Nothing
.Quit
End With
GetFilePathIE2 = stmXml

Set olkApp = CreateObject("Outlook.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set stmXml2 = objFSO.OpenTextFile(stmXml, 1)
' 1 行目はビューの名前と種類
strLine = stmXml2.ReadLine
arrLine = Split(strLine, vbTab)
Set colViews = olkApp.ActiveExplorer.CurrentFolder.Views
Set curView = colViews.Add(arrLine(0), arrLine(1), 0)
If Err.Number = 5 Then ' 同名のビューが存在した場合のエラー処理
For Each curView In colViews
' 同名のビューを検索
If curView.Name = arrLine(0) Then
Exit For
End If
Next
End If
curView.XML = stmXml2.ReadAll
curView.Save
curView.Apply
stmXml2.Close

投稿日時 - 2019-02-01 22:14:09