エクスプローラで起動時にサムネイル表示

やみ〜 2008-02-06 20:41:15 No: 100235

画像用のフォルダをエクスプローラで開くシステムを作りました。

ShellExecute vbNull, "Open", "Explorer.exe", _
strDstFolder, strDstFolder, SW_SHOWMAXIMIZED

が、
ユーザーから「サムネイル表示（縮小版）で開くようにしろ！」
という要求がありました。
が、
方法が判りません。

どなたか助けてください！
よろしくお願いします〜！

我龍院 2008-02-07 00:51:02 No: 100236

助けてくれといわれてもね...(^^;
Explorerは特殊なんでなるべくなら触りたくない代物です。
下のコードはいつも成功するとは限りません。(^^;
ひとえにWindowのハンドルが取れるか否かにかかっています。
取れたら強引にメニューを開いて、縮小版に設定すると言う
苦し紛れのコードとなっています。
2秒挑戦して駄目だったらすごすごと引き上げます。

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Const SW_SHOWMAXIMIZED = 3
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, _
    ByVal lpFile As String, ByVal lpParameters As String, _
    ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Sub Command1_Click()
    Dim Folder As String
    Dim Rt As Long
    Dim hwnd As Long
    Dim bTime As Long
    Dim ApId As Integer
    Folder = "C:\"
    ApId = ShellExecute(vbNull, "Open", "Explorer.exe", Folder, vbNull, SW_SHOWMAXIMIZED)
    bTime = timeGetTime
    Do
        hwnd = FindWindow("ExploreWClass", vbNullString)
        If hwnd = 0 Then
            hwnd = FindWindow("CabinetWClass", vbNullString)
        End If
        DoEvents
        If timeGetTime - bTime > 2000 Then
            Exit Sub
        End If
    Loop While (hwnd = 0)
    Do
        DoEvents
        If timeGetTime - bTime > 2000 Then
            Exit Sub
        End If
    Loop While (SetForegroundWindow(hwnd) = 0)
    SendKeys ("%VH")
End Sub

K.J.K. 2008-02-07 01:34:59 No: 100237

# 久々に書き込み。

WScript (中身はVBScript)で行うのならば、こんな感じ。
OSやWScriptのバージョンにかなり依存するとは思います。
# なぜ、VB6ではなくVBScriptで書いてあるのかを考えましょう。

Dim sPath
Dim oShell
Dim oWindows
Dim oIE
Dim oView
Dim oFolder
Dim oItem

sPath = WScript.Arguments(0)
Set oShell = WScript.CreateObject("Shell.Application")
Call oShell.Open(sPath)
Set oWindows = oShell.Windows
Set oShell = Nothing

For Each oIE In oWindows
    Set oView = oIE.Document
    If "IShellFolderViewDual2" = TypeName(oView) Then
        Set oFolder = oView.Folder
  Set oItem = oFolder.Self
        If sPath = oItem.Path Then
      oView.CurrentViewMode = 5
            Exit For
        End If
        Set oFolder = Nothing
    End If
    Set oView = Nothing
Next
Set oWindows = Nothing

す 2008-02-07 01:38:36 No: 100238

CurrentViewModeが使えます

やみ〜 2008-02-07 03:28:37 No: 100239

みなさん、いろいろとありがとうございます。

VB6にこだわって、CurrentViewModeで、いろいろと調べたのですが、
XPのみで、2000非対応でした。

> VBScriptで書いてあるのかを考えましょう。

ごめんなさい。よく判りません。
そして、VBScriptで作る技術と時間がありません。

ユーザーには、それらしい言い訳をして、
諦めてもらうことにします。

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

す 2008-02-08 05:00:13 No: 100240

> # なぜ、VB6ではなくVBScriptで書いてあるのかを考えましょう。

考えてみましたが、結局、分かりませんでした。

コードを見て思ったのは、
Open()は非同期なので、タイミングで捕捉できないことがありそう。
CreateObject("InternetExplorer.Application")したほうが確実なのに。
です。

K.J.K. 2008-02-08 06:06:03 No: 100241

CurrentViewModeプロパティの型は何でしょうか?
VB6に移植する場合は、ShellFolderView型ではなくObject型を使うことで
回避することができるとかできないとか。