ファイル選択ダイアログを表示する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


















この記事へのコメントはありません。