2017年11月
      1 2 3 4
5 6 7 8 9 10 11
12 13 14 15 16 17 18
19 20 21 22 23 24 25
26 27 28 29 30    
無料ブログはココログ

« 2007年12月 | トップページ | 2008年2月 »

2008年1月31日 (木)

ショートカットの相対パス

WshShortcut オブジェクトのRelativePath プロパティの使い方は、ヘルプを見ても謎です。
http://msdn.microsoft.com/library/ja/script56/html/wslrfRelativePathProperty.asp?frame=true
MSDNライブラリの IShellLink::SetRelativePath Method の説明を見ても謎です。しかも、WSHのヘルプとは矛盾するような説明です。
http://msdn2.microsoft.com/en-us/library/bb761054(VS.85,printer).aspx

しかし、ショートカットのファイル構造には、相対パス欄があって、実際に使われているようです。
ショートカットのコメントと作業フォルダに何か入れて、ショートカットをメモ帳で見ると、コメントと作業フォルダの間に相対パスが設定されています。
これは、ショートカットファイルの場所(親フォルダ)からターゲットへの相対パスになっています。
例えば、ターゲットがショートカットと同じフォルダにあれば、.\ターゲット

WshShortcut オブジェクトのRelativePath プロパティは、設定のみ可能なプロパティで、参照するとエラーになります。
設定は、ショートカットファイルのパスを指定するのが正しいようです。
ただし、それがデフォルトのようで、明に設定しなくても同じです。

ここで、もし、空を指定すると、ショートカットファイルの相対パス欄がなくなります。
相対パス欄がないと、自動追跡の精度が落ちそうですが、試した限りでは変化はありません。

2008年1月30日 (水)

Office FileSearchを代替する。(その2)

方法 2.5 ディレクトリ再帰はFileSystemObject、ファイル検索はDIR関数と折衷する方法があります。

本来、方法 2.5 は、方法 1 と性能的にコンパラブルなはずですが、MSのサンプルコードは出来があまり良くないようです。

方法 1 は、以下の、方法 2.5 のコードより2倍くらい遅い。

Dim fso As Object
Dim n As Long

Sub Sample()
Dim Folder As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set Folder = fso.GetFolder("C:\")
t1 = Timer
n = 0
Proc Folder
Debug.Print Timer - t1, , n
End Sub

Sub Proc(Folder)
Dim SubFolder As Object
Dim File As String
On Error GoTo e1
For Each SubFolder In Folder.SubFolders
  Proc SubFolder
Next
File = Dir(Folder.path & "\*.xls")
Do While Len(File)
  Debug.Print Folder.path & "\" & File
  n = n + 1
  File = Dir()
Loop
Exit Sub
e1:
Debug.Print Folder.path & "\" & File, File, Err.Number, Err.Description
End Sub

なので、方法 1 を選択するときは、MSのコードを見直したほうがよいでしょう。
2倍くらい速くなるはずです。
GetFileAttributes()で情報を取り直しているのがよくないような。。。

方法 2 は、そういう改善が無理そうなので、方法 2.5 に変えたほうがよいでしょう。

ということで、結局、お勧めは、方法 2.5 か、方法 1 を改善したもの、です。

2008年1月29日 (火)

Office FileSearchを代替する。

FileSearchは、Office 2007で使えませんが、その代替は、

ディレクトリ内のファイルの検索またはファイル一覧の取得を行う方法
http://support.microsoft.com/kb/185476/ja

に次の3案が示されています。

方法 1 : Windows API を使用する
方法 2 : 組み込みの Visual Basic 関数を使用する
方法 3 : Visual Basic で FileSystemObject を使用する

この中では、方法 1、方法 2 が「一応」お勧めです。お勧めでないのは、方法 3 です。

方法 3 は、検索で除外される大多数のエントリに対するオブジェクトの生成廃棄のコストが大きくて、とても遅くなります。
WMIのWQLを使った検索も、同じ理由で、お勧めしません。
WMI Tasks: Files and Folders
Windows Desktop Searchも、遅そう。
Seek and Ye Shall Find: Scripting Windows Desktop Search 3.0

方法 1 と方法 2 は「一応」性能的にコンパラブルなので、お好みで選択すればよいでしょう。

スクリプトの場合は、方法 1、方法 2が使えないので、代りに、DIRコマンドがよさそう。
例えば、
MsgBox CreateObject("WScript.Shell").Run("cmd /c for /f %r in ('dir /s /b c:\*.xls^|find /c /v """"') do exit %r", 1, True)

2008年1月28日 (月)

コマンドラインから関連付けの動詞(Print/PrintTo)で印刷する。

印刷に特化すれば、コマンドラインが簡単になります。

Print.CMD ファイル

@if(0)==(0) ECHO OFF
CScript.exe //NoLogo //E:JScript "%~f0" %*
GOTO :EOF
@end
new ActiveXObject("Shell.Application").ShellExecute(WScript.Arguments.Item(0),null,null,"print");
WScript.Sleep(10000);

PrintTo.CMD ファイル "プリンタ名"

@if(0)==(0) ECHO OFF
CScript.exe //NoLogo //E:JScript "%~f0" %*
GOTO :EOF
@end
new ActiveXObject("Shell.Application").ShellExecute(WScript.Arguments.Item(0),'"'+WScript.Arguments.Item(1)+'"',null,"printto");
WScript.Sleep(10000);

関連付け(特にDDE)は非同期なので、待ち時間が短いと処理が抜けます。:-(

2008年1月25日 (金)

コマンドラインから関連付けの動詞(Verb)を起動する。

エクスプローラから右クリックで起動するようなことを、コマンドラインから起動するには、
Shell.Applicationのメソッド
Sub ShellExecute(File As String, [vArgs], [vDir], [vOperation], [vShow])
を呼び出します。

ShellExec.CMD ファイル [引数... [作業フォルダ [動詞 [ウィンドウの大きさ]]]]

@if(0)==(0) ECHO OFF
CScript.exe //NoLogo //E:JScript "%~f0" %*
GOTO :EOF
@end
with(WScript.Arguments) new ActiveXObject("Shell.Application").ShellExecute(Item(0),Count()>1?Item(1).replace(/`/g,'"'):undefined,Count()>2?Item(2):undefined,Count()>3?Item(3):undefined,Count()>4?parseInt(Item(4)):undefined);
WScript.Sleep(5000);

例えば、Excelファイルを印刷するには、

ShellExec.CMD Excelファイル "" "" print

例えば、プリンタを指定してExcelファイルを印刷するには、

ShellExec.CMD Excelファイル "`プリンタ名`" "" printto

引数の中に"を渡すときは、代わりに`を指定します。

2008年1月24日 (木)

リムーバブルへのショートカットを代替する(その2)

リムーバブルへのショートカットは、ドライブレターが変わると困るので、ボリュームラベル指定のバッチファイルやショートカットで代替します。

下記で、
ボリュームラベル
作業フォルダ
パス
[引数...]
の4箇所を書き換えて使用します。
もし、ボリュームラベルに空白を含む場合は、空白より前だけ。
ドライブレターを適宜絞り込んでも可。

リムーバブルへのショートカット.CMD

FOR /F "tokens=1-5" %%1 IN ('VOL C: D: E: F: G: H: I: J: K: L: M: N: O: P: Q: R: S: T: U: V: W: X: Y: Z:') DO IF "%%5"=="ボリュームラベル" START "" /D"%%2:\作業フォルダ" "パス" [引数...]

リムーバブルへのショートカット.lnk

cmd.exe /c FOR /F "tokens=1-5" %1 IN ('VOL C: D: E: F: G: H: I: J: K: L: M: N: O: P: Q: R: S: T: U: V: W: X: Y: Z:') DO IF "%5"=="ボリュームラベル" START "" /D"%2:\作業フォルダ" "パス" [引数...]

ショートカットの実行時の大きさは、最小化または非表示(過去記事参照)にします。

これらは、マシン側、リムーバブル側のいずれに置いても使えます。

2008年1月22日 (火)

リムーバブルへのショートカットを代替する

リムーバブルへのショートカットは、ドライブレターが変わると困るので、ボリュームラベル指定のVBSファイルで代替します。

ボリュームラベル
パス(ドライブ指定(x:)抜き、または、作業フォルダからの相対パス)
[引数...]
作業フォルダ(ルートフォルダ(x:\)抜き)
の4箇所を書き換えて使用します。

リムーバブルへのショートカット.VBS

VolumeName="ボリュームラベル"
Set Shell=CreateObject("Shell.Application")
For Each FolderItem In Shell.NameSpace(17).Items()
  If FolderItem.ExtendedProperty("FileSystem")<>"" Then
    Name=FolderItem.Name
    If Left(Name,Len(Name)-5)=VolumeName Then Exit For
  End If
Next
If IsEmpty(FolderItem) Then
  MsgBox VolumeName & " がありません。"
Else
  Shell.ShellExecute "パス","[引数...]",FolderItem.Path & "作業フォルダ"
  WScript.Sleep 5000
End If

(注) ショートカットの場合は、自動追跡でターゲットは補正されても、作業フォルダが補正されません。:-(

2008年1月21日 (月)

関連付けの起動コマンドラインを確認する

関連付けで起動するときの実際のコマンドラインを確認したいとき、レジストリのCommandキーのコマンドラインの先頭に'msg * 'を追加すると、起動の代わりにコマンドラインがメッセージボックスに表示されます。

'CMD /K ECHO 'を使えば、コンソールに表示されます。

※MSGコマンドは、XPではHomeEditionにもありましたが、VistaではHomeBasicにはないようです。

2008年1月18日 (金)

ファイル名の大文字と小文字の違いだけの変更

FileSystemObject の File.Name=新しい名前 では、ファイル名の大文字と小文字の違いだけの変更ができません:-(

Shell.Application の FolderItem.Name=新しい名前 なら出来ます。

と、ここまでは知ってましたが、更に、

FileSystemObject の MoveFile(古いパス,新しいパス) でも出来るようです。

ただし、FSOでは、エクスプローラへの反映が遅延します。
また、MoveFolder() は駄目です。

やはり、Shell.Application のほうがお勧めです。

2008年1月17日 (木)

Excelでマルチタスク処理

Excelでマルチスレッド処理は出来ませんが、マルチプロセス処理なら出来るんじゃない?

例えば、

標準モジュールに
Sub Proc(Arg1)
~~~
Application.Quit
End Sub
を作って、

Dim xl As Excel.Application
Set xl = CreateObject("Excel.Application")
xl.Workbooks.Add ThisWorkbook.FullName
xl.OnTime Now, "'Proc ""aaaa""'"
Set xl = Nothing
すると、別プロセスでProcを実行します。

2008年1月16日 (水)

Excelの複数バージョンが混在する環境で異なるバージョンのExcelを使う。

CreateObject("Excel.Application")やCreateObject("Excel.Application.??")では、最新バージョンのExcelしか取れません。

そこで、Shell(""""フルパス\EXCEL.EXE"" ""仮のExcelファイル""")などで起動して、GetObject("仮のExcelファイル")で、Workbookオブジェクトを得て、その.ApplicationからExcel.Applicationオブジェクトを得ることができます。

あるいは、Shell(""""フルパス\EXCEL.EXE""")などで起動して、n=1で、GetObject("Book" & n)で、Workbookオブジェクトを得て、その.ApplicationからExcel.Applicationオブジェクトを得て、そのバージョンを調べて、違っていたら、nを+1して、繰り返します。

ここで、もし、ROT(Running Object Table)を使えば、もっとスマートにできます。でも、ROTを使うのは.NETでないと、ちょっと難しいかも。

あるいは、レジストリの
HKEY_CLASSES_ROOT\CLSID\{00024500-0000-0000-C000-000000000046}\LocalServer32
を書き換えてから、CreateObject("Excel.Application")します。

レジストリの書き換えは、各バージョンの
"フルパス\EXCEL.EXE" /regserver
でもできます。

環境がないので、アイデアだけで試してません。:-p

2008年1月15日 (火)

Excelの複数バージョンが混在する環境で異なるバージョンのExcelで開く。

関連付けで開くと、最新バージョンか起動中バージョンのアプリで開きます。

旧バージョンで開くには、旧バージョンのアプリを起動してから、関連付けで開くか、そのアプリメニューから開きます。

それが面倒なら、関連付けに各バージョンで開く動詞を追加します。

例えば、.xlsファイルに"Excel 2007で開く(&2)"などを追加するには、

HKEY_CLASSES_ROOT\Excel.Sheet.8\shell\Open2007\
"Excel 2007で開く(&2)"
HKEY_CLASSES_ROOT\Excel.Sheet.8\shell\Open2007\command\
"C:\Program Files\Microsoft Office\Office12\EXCEL.EXE" "%1"

HKEY_CLASSES_ROOT\Excel.Sheet.8\shell\Open2003\
"Excel 2003で開く(&1)"
HKEY_CLASSES_ROOT\Excel.Sheet.8\shell\Open2003\command\
"C:\Program Files\Microsoft Office\Office11\EXCEL.EXE" "%1"

HKEY_CLASSES_ROOT\Excel.Sheet.8\shell\Open2002\
"Excel 2002で開く(&0)"
HKEY_CLASSES_ROOT\Excel.Sheet.8\shell\Open2002\command\
"C:\Program Files\Microsoft Office\Office10\EXCEL.EXE" "%1"

HKEY_CLASSES_ROOT\Excel.Sheet.8\shell\Open2000\
"Excel 2000で開く(&9)"
HKEY_CLASSES_ROOT\Excel.Sheet.8\shell\Open2000\command\
"C:\Program Files\Microsoft Office\Office\EXCEL.EXE" "%1"

HKEY_CLASSES_ROOT\Excel.Sheet.8\shell\Open97\
"Excel 97で開く(&8)"
HKEY_CLASSES_ROOT\Excel.Sheet.8\shell\Open97\command\
"C:\Program Files\Microsoft Office\Office\EXCEL.EXE" "%1"

ポイントはDDEを使わないことです。

環境がないので、アイデアだけで試してません。:-p

2008年1月14日 (月)

MSGコマンドを使ってコマンドプロンプトやバッチファイルからメッセージボックスを出す。

バッチの終了をメッセージボックスで通知したりできます。

msg 0 バッチが終了しました。ERRORLEVEL=%ERRORLEVEL%

特に、パイプを使って標準入力をメッセージボックスに表示できます。

dir | msg 0

PAUSEの代わりにも使えます。

msg 0 /w 続行するには[OK]ボタンを押してください . . .

SLEEPの代わりにも使えます。

msg 0 /w /time:5 5秒待ちます . . .

※MSGコマンドは、XPではHomeEditionにもありましたが、VistaではHomeBasicにはないようです。

2008年1月13日 (日)

MSGコマンド

MSGコマンドは、送信先が必須なので、ユーザ名、セッション名、セッションIDなどを指定します。

MSG %USERNAME%

MSG %SESSIONNAME%

MSG Console

MSG 0

MSG *

同時に複数のメッセージボックスは出せません。逐次化されます。

※MSGコマンドは、XPではHomeEditionにもありましたが、VistaではHomeBasicにはないようです。

VBAやHTAでn秒後に自動的に閉じるメッセージボックス(その2)

WScript.ShellのPopUp()の秒指定は、ExcelやHTAなどでは使えません。:-(

そこで、MSGコマンドを利用した代替方法です。

Shell "cmd /c msg %username% /time:5 ""5秒後に自動的に閉じます。""", vbHide

CreateObject("WScript.Shell").Run "msg %username% /time:5 ""5秒後に自動的に閉じます。""", vbHide, False

これらは非同期です。応答を待ち合わせる場合は、

CreateObject("WScript.Shell").Run "msg %username% /time:5 /w ""5秒後に自動的に閉じます。""", vbHide, True

※MSGコマンドは、XPではHomeEditionにもありましたが、VistaではHomeBasicにはないようです。

2008年1月11日 (金)

VBAでn秒後に自動的に閉じるメッセージボックス

WScript.ShellのPopUp()の秒指定は、Excelなどでは使えません。:-(

そこで、user32.dllのMessageBoxTimeoutA()を利用した代替方法です。

Private Declare Function MessageBoxTimeoutA Lib "user32" ( _
        ByVal hWnd As Long, ByVal lpText As String _
      , ByVal lpCaption As String, ByVal uType As Long _
      , ByVal wLanguageId As Long, ByVal dwMilliseconds As Long _
      ) As Long

Sub hoge()
    MessageBoxTimeoutA 0&, "5秒後に閉じます。", "タイトル", vbMsgBoxSetForeground, 0, 5000
End Sub

Undocumentedです。XP(SP2)では使えますが、他は知りません。どうも、XP以降らしい。

2008年1月10日 (木)

ショートカットに相対パスを指定する。

ショートカットに相対パスを指定することができるか?という質問がよくあります。
その答えは、
ショートカットファイルからの相対パスは、できない。
カレントディレクトリからの相対パスなら、できる。

エクスプローラからショートカットファイルをダブルクリックしたときのカレントディレクトリはショートカットファイルの場所なので、それでよければ、ショートカットのターゲットと引数を以下のように指定します。

%windir%\system32\rundll32.exe shell32.dll,ShellExec_RunDLL "相対パス(注1)" [引数...]

もし、ショートカットの作業フォルダを指定すると、そこからの相対パスになります。
なので、ショートカットの作業フォルダは、空にしておきます。

もし、引数が不要なら、

%windir%\system32\rundll32.exe url.dll,FileProtocolHandler "相対パス"

でも可。

単にフォルダを開くだけなら、

%windir%\explorer.exe /n,"相対パス"

%windir%\explorer.exe /e,"相対パス"

でも可。

あるいは、また、

%COMSPEC% /C START "" "相対パス" [引数...]

として、最小化にしておきます。

フルパスが必要な場合は、例えば、

%COMSPEC% /C START "" "file://%CD%\相対パス" [引数...]

とします。

ショートカットファイルからの相対パスは無理ですが、バッチファイルやWSH、HTM、HTAなら%~f0やWScript.ScriptFullName、location.pathnameで自身のパスを得て代替できます。

バッチファイル

START "" /D "%~dp0" "相対パス" [引数...]

VBSファイル

CreateObject("Shell.Application").ShellExecute "相対パス","[引数...]",WScript.ScriptFullName & "\.."
WScript.Sleep 5000

(注1)
ShellExec_RunDLLは、本来、アプリ起動用なので、単純名(\を含まない)を指定すると、%SystemRoot%\System32やPATHを検索します。
ShellExec_RunDLLで、検索に行かないようにするには、\と名前の両方を含むパス名を指定します。
例えば、カレントディレクトリ内の名前は、".\名前"とします。
特殊な例では、"."や".."も、%SystemRoot%\System32を検索して見つかるようです。
なので、"."は"..\現フォルダ名"、".."は"..\..\親フォルダ名"とします。

※VistaではShellExec_RunDLLの仕様が変わったようで、この手が使えないようです。
詳しくは、http://scripting.cocolog-nifty.com/blog/2010/03/post-b124.html

2008年1月 7日 (月)

Excelの終了を待ち合わせる。

CreateObject()したExcelプロセスの終了をどうやったら待てるか?
ExcelをCreateObject()して、ユーザがGUIで操作してからExcelを閉じたのをどうやったら検出できるか?

方法1

Excelへの参照を保持したままでは、ユーザがGUI操作でExcelを閉じても、Excelプロセスは終了しません。
でも、非表示にはなるので、Application.Visible=False で代用できます。
その後にExcelへの参照を解放すれば、Excelプロセスは終了します。

Set Application=CreateObject("Excel.Application")
Application.Visible=True
Application.UserControl=True
Do While Application.Visible=True
  WScript.Sleep 1000
Loop
Set Application=Nothing
WScript.Echo "終了"

方法2

Excelへの参照を解放しておけば、ユーザがGUI操作でExcelを閉じると、Excelプロセスも終了します。
その場合は、先にExcelのプロセスIDを調べておいて、そのプロセスの終了を監視すればよいのです。

Set Application=CreateObject("Excel.Application")
Application.Visible=True
Application.UserControl=True
PID=Application.ExecuteExcel4Macro("CALL(""Kernel32"",""GetCurrentProcessId"",""J"")")
Set Application=Nothing
Do While GetObject("winmgmts:\\.\root\CIMV2").ExecQuery("SELECT * FROM Win32_Process WHERE ProcessID="&PID).Count
  WScript.Sleep 1000
Loop
WScript.Echo "終了"

2008年1月 6日 (日)

マイコンピュータゾーンになる汎用のURLになりそうなもの

インターネットゾーンでよければ、about:blankですが、インターネットゾーンのセキュリティレベルが高いと、何も出来ないので、マイコンピュータゾーンになるabout:blankのような標準的なURLはないものでしょうか?

そこで、
C:\WINDOWS\Web\tips.gif
C:\WINDOWS\system32\ntimage.gif
C:\WINDOWS\system32\eula.txt
C:\WINDOWS\I386\EULA.TXT
などがabout:blankの代わりに使えそうです。
環境依存なので自分用ですが。

例えば、クリップボードの定番、

Set ie=CreateObject("InternetExplorer.Application")
ie.Navigate "about:blank"
Do While ie.Busy Or ie.ReadyState<>4
  WScript.Sleep 100
Loop
ie.Document.parentWindow.clipboardData.setData "text","aaaa"
MsgBox ie.Document.parentWindow.clipboardData.getData("text")
ie.Quit

が駄目でも、

Set ie=CreateObject("InternetExplorer.Application")
ie.Navigate "C:\WINDOWS\Web\tips.gif"
Do While ie.Busy Or ie.ReadyState<>4
  WScript.Sleep 100
Loop
ie.Document.parentWindow.clipboardData.setData "text","aaaa"
MsgBox ie.Document.parentWindow.clipboardData.getData("text")
ie.Quit

にすればOKです。

ただ、これもマイコンピュータゾーンのセキュリティレベルを高くしてると駄目ですが。
その場合や他人用は、ExecWBを使う方式で。

2008年1月 5日 (土)

IEの既存のプロセスの新規ウィンドウで開く。

WWW_OpenURLNewWindow.VBS {ファイル|URL}

URL=WScript.Arguments.Item(0)
Set Application=CreateObject("Excel.Application")
Application.DisplayAlerts=False
channelNumber=Application.DDEInitiate("IExplore","WWW_OpenURLNewWindow")
Application.DisplayAlerts=True
If TypeName(channelNumber)="Error" Then
  CreateObject("WScript.Shell").Run "IExplore.exe " & """" & URL & """"
Else
  Application.DDEExecute channelNumber,"""" & URL & """,,-1,0,,,,"
  Application.DDETerminate channelNumber
End If

これは、WWW_OpenURLで、第3パラメタのWindowIDを-1(最新)でなく、0(新規)を指定しても同じです。

WWW_OpenURL2.VBS {ファイル|URL}

URL=WScript.Arguments.Item(0)
Set Application=CreateObject("Excel.Application")
Application.DisplayAlerts=False
channelNumber=Application.DDEInitiate("IExplore","WWW_OpenURL")
Application.DisplayAlerts=True
If TypeName(channelNumber)="Error" Then
  CreateObject("WScript.Shell").Run "IExplore.exe " & """" & URL & """"
Else
  Application.DDEExecute channelNumber,"""" & URL & """,,0,,,,,"
  Application.DDETerminate channelNumber
End If

2008年1月 4日 (金)

IEの既存のウィンドウで開く。

WWW_OpenURL.VBS {ファイル|URL}

URL=WScript.Arguments.Item(0)
Set Application=CreateObject("Excel.Application")
Application.DisplayAlerts=False
channelNumber=Application.DDEInitiate("IExplore","WWW_OpenURL")
Application.DisplayAlerts=True
If TypeName(channelNumber)="Error" Then
  CreateObject("WScript.Shell").Run "IExplore.exe " & """" & URL & """"
Else
  Application.DDEExecute channelNumber,"""" & URL & """,,-1,,,,,"
  Application.DDETerminate channelNumber
End If

« 2007年12月 | トップページ | 2008年2月 »