今、いきいきパソコン談話室で「デジカメ」談話中で、写真は「日付別フォルダー」で整理するようにしている。
CD−R に焼いた時、ジャケットに印刷するデータをエクセル・マクロ（VBA）で作ろう‥‥ と、この一週間構想を練って（ループして）いたが、昨日・今日でほぼ完成させた。
■ 苦労したコード
結果として、「mougモーグ）」，「Office Tanaka」に大変お世話になった。
- フォルダを選択するダイアログ （Office Tanaka）
フォルダを選択するダイアログボックスを表示するにはいくつかの方法があります。
- 他アプリを起動する (mougモーグ)
- Shell関数でアプリケーションを起動する
Shell関数で起動したメモ帳をVBAから操作することは難しいです。
起動したメモ帳はアクティブなウィンドウとなるので、VBAからSendKeysという命令を実行して、任意のキーが「押されたこと」にして、何かの操作を行わせることは可能です。 ただし、上記のSample2は環境によっては失敗します。
Shell関数はメモ帳を起動しますが、VBAからはメモ帳が「完全に起動し終わった」かどうかの判断がつきません。したがって、メモ帳が完全に起動し終わる前にSendKeysメソッドが実行されてしまうと、"%EP" のキーコードはExcelに対して送信されてしまうのです。 - ファイルに関連付けられたアプリケーションを起動する
こうした"拡張子関連づけ"でアプリケーションを起動するには、WSH(Windows Script Host)の機能を使うと簡単です。 次のコードは、WSHのWshShellクラスのインスタンスを作成し、Runメソッドで"C:\Data\Image.JPG"ファイルを開きます。
- Shell関数でアプリケーションを起動する
■ コード
最終的にはコメントをもっと入れ、「検索」出来るようにする予定。
Option Explicit
Public MacroName As String
Public MacroPath As String 'マクロファイルが置いてあるパス
Public ListupFolderName As String
Public LngAns As Long
Public StrAns As String
Public VarAns As Variant
Public Sub Auto_Open()
Dim dsn As Long, dsn1 As Long, dsn2 As Long
Dim i As Long, r As Long
Dim strFileList As String, strFolderList As String, strFullPath As String
Dim strText As String, strCDFile As String
MacroName = ThisWorkbook.Name
MacroPath = ThisWorkbook.Path
'リストアップするフォルダを取得する。
ListupFolderName = getフォルダ名()
If ListupFolderName = "" Then Exit Sub
'ファイルリストを作る。
strFileList = MacroPath & "\FileList.txt"
VarAns = getファイル(strFileList)
'出力ファイルを開く。
strCDFile = MacroPath & "\CDJacketText.txt"
dsn = FreeFile
Open strCDFile For Output As dsn
'FileListから直下のファイル名を取り込む。
dsn1 = FreeFile
Open strFileList For Input As dsn1
For i = 1 To 3
Line Input #dsn1, strText
If Left(strText, 5) <> "ボリューム" Then Print #dsn, strText
Next
Do While Not EOF(dsn1)
Line Input #dsn1, strText
If Left(strText, 1) = "│" Then
Print #dsn, strText
Else
Close #dsn1
Exit Do
End If
Loop
Close #dsn1
'フォルダリストを作る。
strFolderList = MacroPath & "\FolderList.txt"
VarAns = getフォルダ(strFolderList)
'FolderListからフォルダ名を取り込む。
dsn2 = FreeFile
Open strFolderList For Input As dsn2
For i = 1 To 3 'ヘッダ部分を読み捨てる。
Line Input #dsn1, strText
Next
Do While Not EOF(dsn1)
Line Input #dsn2, strText
Print #dsn, strText
Loop
Close #dsn2
Close #dsn
'メモ帳で開いてアクティブにし、閉じるのを待つ）
With CreateObject("Wscript.Shell")
LngAns = .Run("notepad.exe " & strCDFile, vbNormalFocus, True)
End With
'テキストファイルを削除する。
Kill strFileList
Kill strFolderList
Kill strCDFile
'保存したことにする (保存はしない)
ThisWorkbook.Saved = True
'Excel を終了する
Application.Quit
'自分以外の Book は保存の問い合わせが出る
ThisWorkbook.Close False
End Sub
Public Function getファイル(argOutFile As String)
Dim ret As Long
Dim strCommand As String
strCommand = "tree " & ListupFolderName & " /f >" & argOutFile
With CreateObject("Wscript.Shell")
ret = .Run("cmd /c" & strCommand, 7, True)
End With
End Function
Public Function getフォルダ(argOutFile As String)
Dim ret As Long
Dim strCommand As String
strCommand = "tree " & ListupFolderName & ">" & argOutFile
With CreateObject("Wscript.Shell")
ret = .Run("cmd /c" & strCommand, 7, True)
End With
End Function
Public Function getフォルダ名() As String
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
getフォルダ名 = .SelectedItems(1)
Else
getフォルダ名 = ""
End If
End With
End Function
■ Run メソッド
【構文】 object.Run(strCommand, [intWindowStyle], [bWaitOnReturn])
- object
WshShell オブジェクトです。 - strCommand
実行するコマンド ラインを示す文字列値です。この引数には、実行可能ファイルに渡すべきパラメータをすべて含める必要があります。 - intWindowStyle
省略可能です。プログラムのウィンドウの外観を示す整数値です。すべてのプログラムがこの情報を使用するわけではないので注意してください。- 0：ウィンドウを非表示にし、別のウィンドウをアクティブにします。
- 1：ウィンドウをアクティブにして表示します。ウィンドウが最小化または最大化されている場合は、元のサイズと位置に戻ります。アプリケーションでウィンドウを最初に表示するときには、このフラグを指定してください。
- 2：ウィンドウをアクティブにし、最小化ウィンドウとして表示します。
- 3：ウィンドウをアクティブにし、最大化ウィンドウとして表示します。
- 4：ウィンドウを最新のサイズと位置で表示します。アクティブなウィンドウは切り替わりません。
- 5：ウィンドウをアクティブにし、現在のサイズと位置で表示します。
- 6：指定したウィンドウを最小化し、Z オーダー上で次に上位となるウィンドウをアクティブにします。
- 7：ウィンドウを最小化ウィンドウとして表示します。アクティブなウィンドウは切り替わりません。
- 8：ウィンドウを現在の状態で表示します。アクティブなウィンドウは切り替わりません。
- 9：ウィンドウをアクティブにして表示します。ウィンドウが最小化または最大化されている場合は、元のサイズと位置に戻ります。アプリケーションで最小化ウィンドウを復元するときには、このフラグを指定してください。
- 10 アプリケーションを起動したプログラムの状態に基づいて、表示状態を設定します。
- bWaitOnReturn
省略可能です。スクリプト内の次のステートメントに進まずにプログラムの実行が終了するまでスクリプトを待機させるかどうかを示すブール値です。bWaitOnReturn に TRUE を指定すると、プログラムの実行が終了するまでスクリプトの実行は中断され、Run メソッドはアプリケーションから返される任意のエラー コードを返します。bWaitOnReturn に FALSE を指定すると、プログラムが開始すると Run メソッドは即座に復帰して自動的に 0 を返します (これをエラー コードとして解釈しないでください)。
