VBScript

ファイル選択ダイアログ

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

関連記事

  1. VBScript

    Expression WebでVBScriptのコードを書いてみる。

    今日たまたま下記の記事を見つけました。10年近く前の古い記事です。…

  2. Excel

    ドラッグ&ドロップでExcelのアドインを登録するVBScript

    「ドラッグ&ドロップでWordのテンプレートを登録・解除する(VBS)…

  3. VBScript

    SkyDrive上のフォルダーからファイルをダウンロードするVBScript

    前回はSkyDrive APIを利用してドラッグ&ドロップしたファイル…

  4. VBScript

    Microsoft Edgeのバージョン情報をクリップボードにコピーするVBScript

    前回の記事に引き続き、自分の手間を減らすためのスクリプト、今回はMic…

  5. Windows 10

    Microsoft Edgeを起動するVBScript

    前回の記事の関連ですが、下記コードのようにShellExecuteメソ…

  6. Office関連

    Wordのテンプレートをインストールするスクリプト

    Wordマクロをテンプレートにして使用する場合、通常そのテンプレートフ…

コメント

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

  1. 2013年 12月 02日

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP