ファイル選択ダイアログを表示するVBScriptをまとめてみました。
OSやIEのバージョンによっては実行できないものもあります。
Option Explicit 'MsgBox GetFilePathMC() 'MsgBox GetFilePathSF() 'MsgBox GetFilePathUACD() 'MsgBox GetFilePathIE() MsgBox GetFilePathIE2() Private Function GetFilePathMC() 'Comdlg32.ocxを利用したダイアログ '※ 要コントロールデザイン時のライセンス(http://support.microsoft.com/kb/281848/ja) With CreateObject("MSComDlg.CommonDialog") .Filter = "All Files|*.*" .InitDir = "." .MaxFileSize = 256 .ShowOpen GetFilePathMC = .FileName End With End Function Private Function GetFilePathSF() 'SAFRCFileDlg.FileOpenを利用したダイアログ '※ Windows XP限定 With CreateObject("SAFRCFileDlg.FileOpen") If .OpenFileOpenDlg Then GetFilePathSF = .FileName End With End Function Private Function GetFilePathUACD() 'UserAccounts.CommonDialogを利用したダイアログ '※ Windows XP限定 With CreateObject("UserAccounts.CommonDialog") .Filter = "All Files|*.*" .InitialDir = "." If .ShowOpen Then GetFilePathUACD = .FileName End With End Function Private Function GetFilePathIE() 'IEを利用したダイアログ '※ Internet Explorer 8以降ではfakepathが返されます。 Dim iptObj Dim ret With CreateObject("InternetExplorer.Application") .Visible = False .Navigate "about:blank" '表示待ち While .Busy Or .readyState <> 4 WScript.Sleep 100 Wend Set iptObj = .document.createElement("input") iptObj.setAttribute "type", "file" .document.body.appendChild iptObj iptObj.Click ret = iptObj.Value Set iptObj = Nothing .Quit End With GetFilePathIE = ret End Function Private Function GetFilePathIE2() 'IEを利用したダイアログ(2) '※ Internet Explorer 8以降にも対応 Dim iptObj Dim ret With CreateObject("InternetExplorer.Application") .Visible = False .FullScreen = True .Navigate "about:blank" '表示待ち While .Busy Or .readyState <> 4 WScript.Sleep 100 Wend Set iptObj = .document.createElement("input") iptObj.setAttribute "type", "file" .document.body.appendChild iptObj iptObj.Click If Trim(Len(iptObj.Value)) > 0 Then iptObj.Focus .ExecWB 17, 0 'OLECMDID_SELECTALL .ExecWB 12, 0 'OLECMDID_COPY ret = CreateObject("htmlfile").parentWindow.clipboardData.GetData("text") End If Set iptObj = Nothing .Quit End With GetFilePathIE2 = ret End Function
この記事へのコメントはありません。