フォルダ＆ファイル選択ダイアログ

質問

IE上でVBSを使い、BrowseForFolderでフォルダ選択および
ファイル選択が出来るようになったのですが、、、
OSが２０００だと上手くいき、XPだとファイル名が取得できません。

なぜか「書き込みできません」的なエラーが出てしまいます。

これが仕様なら仕方がないのですが、やりたいことは以下の
感じです。

・IEでローカルのファイルやフォルダをユーザに選択させたい
・選ばれたファイルやフォルダを指定のファイルサーバへコピー
・操作はパソコン素人でもわかるように。

社内イントラネットなので、対応しなければいけないのは
OS：Windows2000、XP
IE：６、７

クライアントアプリのインストールは不可。（権限なし）

FileSystemObjectを使えば自作ツールも作れそうですが、
上記の解決方法があるのならば、まずはそちらで対応したいです。
また、他の方法や使えそうなツールがあれば、ご教授いただけると
幸いです。

短納期なため、困っています。。。

回答No.6

nda23 · ベストアンサー

#5で間違いがありました。
N = A.Run("GetFileFolder","タイトル")
If N = "" Then
　　WScript.Echo "キャンセル"
Else
　　'Z = A.Run("GetFileFolder","タイトル") ←この行は不要
== 以下略 ==

GetFileFolderの仕様
Title　　ダイアログのタイトル文字列
InitDir　初期カレントフォルダのパス（省略可能）
戻り値　指定されたファイル/フォルダのパス名　キャンセル時は""
GetAtrの仕様
Path　　ファイル/フォルダのパス名
戻り値　パスがフォルダの場合は16、それ以外は0が返る。

お礼

いまさらですが、ありがとうございました。
お礼をするのを忘れていました。。。

補足

ありがとうございますｍｍ

＃５、＃６を合わせまして作成することが出来ました☆

IEからVBSを使用する場合なんですが、Excel.Application時に
Excelを非表示にしているため、SHBrowseForFolderのダイアログが
タスクバーには表示されますが、画面に出てこないようです。
タスクバーにあるアイコンをクリックしてもダメでした。

そこで
A.Visible = True
を追加したのですが、これだとExcelが表示され、その上にダイアログが
出てくるので、今度はIEが隠れてしまいます。

SHBrowseForFolderに渡すウィンドウハンドルを今開いているIEにしてあげれば
良いのかと思っているのですが、やり方がわかりません・・・

ユーザーのログインセッションの関係で、IE上の既存の画面から
このツールを起動しなくてはいけないため、困りました。。。

しかし、IE→VBS→Excel→VBA→WinAPI とすごいですよね☆
こういうのが実現できたら、うちの開発環境の幅がすごく広がりそうです☆

回答No.9

nda23

今、思いついたんですが、イントラ内の自社システムなら、何も
Webアプリケーションではなく、HTAを使ったクライアント・サーバ型
アプリケーションの方が簡単なような気がします。（参考までに）

お礼

ご回答ありがとうございます。

HTA＋VBScritpという事でしょうか？
もう５年以上運用しているのですが、そう思ったことは何度かあります(^^;

実は次の要望として、クライアントにインストールされている
ソフトウェア種類や使用頻度を取得したいという話が上がっています。
さらにそれを管理したいと。。

なので、HTAを使うかもしれません。

回答No.8

nda23

>画面に出てこないようです。
当方はIE8（WindowsXP SP3）ですが、そのようなことはありませんね。
第一、SHBrowseForFolderは誰が呼び出したかなど関係ありません。
サンプルでは親Windowの設定値が0なので、独立ウィンドウとして
扱われているはずです。逆に言うと、P.Hには何も指定してはいけ
ません。どうしてもと言うなら、せいぜい、デスクトップのハンドル
くらいでしょうか。
http://msdn.microsoft.com/ja-jp/library/cc364616.aspx

>SHBrowseForFolderに渡すウィンドウハンドルを今開いているIE…
今、述べた理由で必要の無い操作です。むしろ、やってはいけません。

どこかのウィンドウの裏側になっていませんかね？

お礼

ありがとうございます。

デスクトップの表示を押すと、ダイアログが表れるのですが、
そうすると今度はIEの方がタスクバーのアイコンをクリックしても
開けなくなります。（？）

環境はIE6 SP1(Windows2000 SP4)

原因だと思うのですが、HTMLを直接ダブルクリックで開いて
いたからではないでしょうか？
http:://～でアクセスしたら問題なく動作しました☆

ありがとうございましたｍｍ

回答No.7

cistronezk

イントラネットならば「file://・・・」で普通にIEで共有フォルダを開けませんでしたっけ？
そこへローカルのファイルをD&Dすればいいような気がしますが、そういう話ではない？

お礼

すみません、、勘違いしていました。

共有フォルダを開いて、そこにローカルファイルをコピーするという
話ですね☆

やりたいことは、共有フォルダ（ネットワーク）を開いて、
フォルダやファイルのパス名を取得し、それのパス名のみをサーバーに送信。

サーバー側で特別権限ユーザーでSamba接続し、パスを元に、マウントし
ファイル/フォルダをサーバー側へコピー。

ユーザー側でエクスプローラーを開かせるのは、自分の権限のものしか
選ばせないためです。（パス名の直書きを禁止）

補足

ご回答ありがとうございます。

今、試してみたのですがcmdからマイネットワークが以下のような方法で
開けました。

explorer.exe /root,,::{208D2C60-3AEA-1069-A2D7-08002B30309D}
なので、VBSからも方法はありそうです。

そこで質問なのですが、このエクプローラを開いたとして、
どのようにIEにD&Dするのでしょうか？
・・・普通にD&Dするとそのフォルダやファイルが開いちゃいます(^^;

フォルダやファイルのパス名が取得出来れば幸いですｍｍ

回答No.5

nda23

(1)以下のマクロを定義したExcelファイルを共通フォルダに置く。
Private Declare Function SHBrowseForFolder& Lib "SHELL32" _
(P As BROWSEINFO)
Private Declare Function SHGetPathFromIDList& Lib "SHELL32" _
(ByVal I&, ByVal P$)
Private Declare Sub CoTaskMemFree Lib "OLE32" (ByVal P&)
Private Declare Sub RtlMoveMemory Lib "KERNEL32" _
(D As Byte, ByVal S$, ByVal L&)
Private Declare Function lstrlenA& Lib "KERNEL32" (ByVal S$)
Private Declare Function SendMessageA& Lib "USER32" _
(ByVal H&, ByVal M&, ByVal W&, ByVal L&)
Private Type BROWSEINFO
　　H　 As Long
　　R　 As Long
　　N　 As String
　　T　 As String
　　F　 As Long
　　M　 As Long
　　L　 As Long
　　I　 As Long
End Type
Function GetAtr&(ByVal Path$)
GetAtr = GetAttr(Path) And vbDirectory
End Function
Function GetFileFolder$(ByVal Title$, Optional ByVal InitDir$)
Dim P As BROWSEINFO
Dim R&, N$

P.F = &H4051
P.T = Title
P.M = G(AddressOf C)
If InitDir <> "" Then
　　R = lstrlenA(InitDir)
　　ReDim B(R) As Byte
　　RtlMoveMemory B(0), InitDir, R
　　P.L = VarPtr(B(0))
End If
R = SHBrowseForFolder(P)
If R <> 0 Then
　　N = String(260, Chr(0))
　　T = SHGetPathFromIDList(R, N)
　　CoTaskMemFree R
　　R = InStr(N, Chr(0))
　　If R > 0 Then N = Left(N, R - 1)
　　GetFileFolder = N
End If
End Function
Private Function C&(ByVal H&, ByVal M&, ByVal W&, ByVal L&)
If M = 1 Then
　　SendMessageA H, &H466, 1, L
End If
End Function
Private Function G&(ByVal P&)
G = P
End Function

(2)VBSの記述
Dim A, N, Z
Set A = CreateObject("Excel.Application")
A.WorkBooks.Open "X:\～",,True '★上記のエクセルファイル
N = A.Run("GetFileFolder","タイトル")
If N = "" Then
　　WScript.Echo "キャンセル"
Else
　　Z = A.Run("GetFileFolder","タイトル")
　　If A.Run("GetAtr",N) = 0 Then
　　　　WScript.Echo N & " はファイルです"
　　Else
　　　　WScript.Echo N & " はフォルダです"
　　End If
End If
A.Quit
Set A = Nothing

お礼

ご回答ありがとうございます。

サンプルまで作成して頂いて感謝しておりますｍｍ
非常に参考になりました。ありがとうございます。

※質問がありますので、＃６の回答への補足に記入したいと思います。

回答No.4

nda23

>ツールはないでしょうか？
それは即ち、クライアントに「特定のプログラムをインストールする」
ということを意味します。通常のWebアプリケーションでは許されない
前提条件です。インストール可能というなら、手段はあります。
簡単なのはExcel+VBAでSHBrowseForFolderを実行するものを決まった
場所に置いて、Excel.Applicationから使うことも考えられます。

お礼

いまさらですが、ありがとうございました。
お礼をするのを忘れていました。。。

補足

ご回答ありがとうございます。

情報不足で申し訳ございません。
社内インフラとして、全クライアントPCにExcel（2000か2007）は
インストールされています。

また、共通ネットワークドライブが１つあり、そこにファイルを置くことは
可能です。

早速、ご指摘のExcel.ApplicationをVBSから起動するところを
調べてみたのですが、自作のモジュールを呼び出せない状態です。

Dim xl
Set xl = CreateObject( "Excel.Application" )
xl.Run( "c:/vb.xls!Hello" )
xl.Quit

'c:/vb.xlsの標準モジュール
Sub Hello
MsgBox "aaa"
End Sub

エラー内容：c:/vb.xls!Helloが見つかりません。

ちなみに肝心のSHBrowseForFolderで
ファイル/フォルダの選択方法が見つけられない状態です。。。

回答No.3

nda23

バージョンの差異ということ、IEでの使用という条件を考えると、
同じ方法でファイルとフォルダの両方を指定させることは難しいと
思います。
SHBrowseForFolder というのはBrowseForFolder が実際に呼び出す
APIのエントリ名で、VBSからはAPIを呼び出すことはできません。
※クライアントサイドに特定のアプリケーションがインストール
　してあると可能にはなりますが、本筋ではありません。
ファイル、フォルダのラジオボタンを設けるなどして、処理を振り
分けるような工夫が必要ではないでしょうか。

お礼

ご回答ありがとうございます。

とりあえず現在は、ラジオボタンで呼び出しを切り分けました。
ちなみにFileSystemObjectを使って、ファイル/フォルダの
選択タイアログを自作されているツールはないでしょうか？

回答No.2

nda23

OSの違いのようです。
http://www.moug.net/faq/viewtopic.php?t=41921

お礼

ありがとうございます。

すみませんが、、、解決方法はあるのでしょうか？
ずっと調べているのですが、見つかりません。。

SHBrowseForFolderの方もIE上でVBSから使っているサンプルが
ないようです。

回答No.1

nda23

どのようなScriptを記述し、どの部分でエラーになるか提示した方が
回答が得られ易いと思いますよ。

お礼

すみません、書き方が悪かったです。
解決してはいません。。。XPだとItemがNothingになってしまうため、
結局、ファイル名が取れなくて困っています。。。

補足

すみません、原因の場所がわかったのですが、XPと2000で挙動が違うようです。
以下の部分は仕様でしょうか？
Dim Item
Dim Shell
Set Shell = SC.EVAL( "CreateObject(""Shell.Application"")")
On Error Resume Next
Set Item = Shell.BrowseForFolder( 0, "aa", &H4000,0 )

'ファイルを選択した場合（フォルダはOK）

If Item is Nothing
'WinXPだとこっちにくる
Else
'Win2000だとこっちにくる
EndIf

※SCはScriptControlでHTML内で以下のように記述
<object id="SC" classid=clsid:0E59F1D5-1FBE-11D0-8FF2-00A0D10038BC>
<param name=Language value="VBScript">
</object>

上記のIf文のところがXPと2000で違う挙動をする部分です。