ファイル参照/保存 ダイアログのまとめ

ファイル参照ダイアログを使用するに当たって、いろいろと手段はあるのですが、まとめて、利点/欠点を考えたことがなかったので、ここらで自分用にまとめ。

ほとんどの内容は吉岡照雄さん作成の、OpenFileDialog.vbsの流用となります。

	引数指定				保存ダイアログ
	FileFilter	Title	MultiSelect	InitDir
1.IEで<input type="file">	△1	×	×	△1	×
2.HtmlDlgHelper	○	○	×	△2	×
3.ExcelでGetOpen	○	○	○	△3	○
4.MSComDlg.CommonDialog	○	○	○	○	○
5.UserAccounts.CommonDialog	○	×	×	○	×
6.SAFRCFileDlg	×	×	×	×	○

△1　SendKeysでフルパスを送り込む ex. "C:\Program Files\*.txt"
△2　initFileにフルパスを入れることで可能
△3　Application.DefaultFilePath を変更してオブジェクトの開放/再取得をする
(他にも方法は有りますが、ExecuteExcel4Macroを使用するので
上記のほうがベターと思われます)

***補足事項***

1. IE8以降ではセキュリティ回避の為の手法が必要
2. あらかじめ<object>としてHtmlに仕込が必要ですが、セキュリティにかかるので、HTAで使用するのが無難
3. Excelがインストールされていないと使用できない
4. VB環境がインストールされていないと使用できない(ランタイムでいけるのかな？)
5. および 6.　OSがXP限定

細かい内容は上記吉岡照雄さんのスクリプトを参考にされるといいかと思います。

追々それぞれの方法については、投稿にしたいと思いますが、
MultiSelectができる手段って限られてるんだな～。
Excel無しでインストール不可の環境だと実質実現できないってことになりますなこりゃ。

VBScript ファイル参照/名前を付けて保存 ダイアログをつかう

Class clsGetFile
'***********************************************************
    ' 機能：ファイル参照ダイアログ表示処理
    ' 引数：FileFilter, FilterIndex, Title, ButtonText, MultiSelect はExcel同様
    ' InitDir 初期表示フォルダ
    ' 戻り値：ファイルフルパス キャンセル時はEmpty
    '注意事項：引数省略時は、""を入力
'***********************************************************
    Function xlGetOpenFilename(FileFilter, FilterIndex, Title, ButtonText,
MultiSelect, InitDir)

    Dim xlApp
    Dim defPath
  
        Set xlApp = CreateObject("Excel.Application")
        defPath = xlApp.DefaultFilePath
      
        If FileFilter = "" Then FileFilter = "すべてのファイル,*.*"
        If FilterIndex = "" Then FilterIndex = 1
        If Title = "" Then Title = "ファイルを開く"
        If ButtonText = "" Then ButtonText = "開く"
        If MultiSelect = "" Then MultiSelect = False
        If InitDir <> "" Then
            With xlApp
                .DefaultFilePath = InitDir
                .Quit
            End With
            Set xlApp = Nothing '開放しないと設定が反映されない為
            Set xlApp = CreateObject("Excel.Application")
        End If
      
        With xlApp
            xlGetOpenFilename = .GetOpenFilename(FileFilter, _
                                                 FilterIndex, _
                                                 Title, _
                                                 ButtonText, _
                                                 MultiSelect)
            If MultiSelect Then
                If Not IsArray(xlGetOpenFilename) Then xlGetOpenFilename = Empty
            Else
                If xlGetOpenFilename = False Then xlGetOpenFilename = Empty
            End If
            .DefaultFilePath = defPath
            .Quit
        End With
        Set xlApp = Nothing
    End Function

'***********************************************************
    ' 機能：名前を付けて保存ダイアログ表示処理
    ' 引数：InitialFilename, FileFilter, FilterIndex, Title, ButtonText はExcel同様
    ' 戻り値：ファイルフルパス キャンセル時はEmpty
    '注意事項：引数省略時は、""を入力
'***********************************************************
    Function xlGetSaveAsFilename(InitialFilename, FileFilter, FilterIndex,
Title, ButtonText)

    Dim xlApp
    Dim defPath
  
        Set xlApp = CreateObject("Excel.Application")
      
        If InitialFilename = "" Then InitialFilename = xlApp.DefaultFilePath
        If FileFilter = "" Then FileFilter = "すべてのファイル,*.*"
        If FilterIndex = "" Then FilterIndex = 1
        If Title = "" Then Title = "名前を付けて保存"
        If ButtonText = "" Then ButtonText = "保存"
      
        With xlApp
            xlGetSaveAsFilename = .GetSaveAsFilename(InitialFilename, _
                                                     FileFilter, _
                                                     FilterIndex, _
                                                     Title, _
                                                     ButtonText)
            If xlGetSaveAsFilename = False Then xlGetSaveAsFilename = Empty
            .Quit
        End With
        Set xlApp = Nothing
    End Function
End Class

=====================================================
要Excelではあるけれど、
ファイルフィルタ/マルチセレクトが使えるのはでかい
起動に時間を要するのが難点かな・・・

2010/11/26　一部修正しました。