Question

我正在使用以下代码在min szie中打开文件夹

Call Shell("explorer.exe" & " " & "D:\Archive\", vbMinimizedFocus)
Call Shell("explorer.exe" & " " & "D:\Shortcuts\", vbMinimizedFocus)

但我喜欢让它们彼此相邻。一个在左侧，一个在右侧。喜欢这个

enter image description here

有人知道打开后是否有办法移动屏幕？

Answer 1

尝试和测试 [Win 7 / Excel 2010 - VBA / 1920 X 1080（移动PC显示器）]

这是一个如何实现你想要的基本例子。我们将使用四个API。

FindWindow
SetParent
SetWindowPos
GetDesktopWindow

我不会单独介绍这些API。要了解他们做了什么，只需单击相应的链接。

<强> LOGIC：

较新的资源管理器没有我在上面的评论中提到的标题。例如，见

enter image description here

然而，玩Spy ++，我能够看到他们有字幕但没有显示在文件夹的标题栏上。见下面的截图。

enter image description here

使用FindWindow API使用Caption
使用SetParent，我们为指定的子窗口（文件夹窗口）分配父窗口，即桌面。
使用SetWindowPos API

<强> CODE：

将此代码粘贴到模块中并根据需要更改文件夹。这是一个非常基本的代码，我没有做任何错误处理。我相信你会照顾它。

Private Declare Function FindWindow Lib "user32.dll" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function SetParent Lib "user32.dll" _
(ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long

Private Declare Function SetWindowPos Lib "user32.dll" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Const SWP_NOZORDER As Long = &H4
Private Const SWP_SHOWWINDOW As Long = &H40

Private Sub Sample()
    Dim lHwnd As Long
    Dim Fldr1Path As String, Fldr2Path As String
    Dim winName As String
    Dim Flder1X As Long, Flder1Y As Long
    Dim FlderWidth As Long, FlderHeight As Long

    '~~> Folder one X,Y screen position
    Flder1_X = 50: Flder1_Y = 50
    '~~> Folder Width and Height. Keepping the same for both
    FlderWidth = 200: FlderHeight = 200

    '~~> Two Folders you want to open
    Fldr1Path = "C:\Temp1"
    Fldr2Path = "C:\Temp2"

    '~~> The Top most folder name which is also the caption of the window
    winName = GetFolderName(Fldr1Path)

    '~~~> Launch the folder
    Shell "explorer.exe" & " " & Fldr1Path, vbMinimizedFocus

    '~~> wait for 2 seconds
    Wait 2

    '~~> Find the Window. 
    '~~> I am using `vbNullString` to make it compatible with XP
    lHwnd = FindWindow(vbNullString, winName)

    '~~> Set the parent as desktop
    SetParent lHwnd, GetDesktopWindow()

    '~~> Move the Window
    SetWindowPos lHwnd, 0, Flder1_X, Flder1_Y, FlderWidth, _
    FlderHeight, SWP_NOZORDER Or SWP_SHOWWINDOW

    '~~> Similary for Folder 2
    winName = GetFolderName(Fldr2Path)
    Shell "explorer.exe" & " " & Fldr2Path, vbMinimizedFocus
    Wait 2
    lHwnd = FindWindow(vbNullString, winName)
    SetParent lHwnd, 0
    SetWindowPos lHwnd, 0, Flder1_X + FlderWidth + 10, Flder1_Y, _
    FlderWidth, FlderHeight, SWP_NOZORDER Or SWP_SHOWWINDOW

    MsgBox "Done"
End Sub

Private Sub Wait(ByVal nSec As Long)
    nSec = nSec + Timer
    While nSec > Timer
        DoEvents
    Wend
End Sub

Function GetFolderName(sPath As String)
    Dim MyAr

    MyAr = Split(sPath, "\")

    GetFolderName = MyAr(UBound(MyAr))
End Function

SCREENSHOT：（已安排的文件夹）

enter image description here

修改

尝试和测试 [Win XP / Excel 2003 - VBA / on VM]

特别感谢Peter Albert为我测试这个。

Answer 2

如果您使用相同的2个文件夹，则可以轻松执行此操作。

1-手动打开两个文件夹，然后设置所需的大小和位置。关闭文件夹。

2-然后下次调用脚本时，请执行以下操作

Set oShell = WScript.CreateObject("WScript.Shell")
oShell.Run "Explorer /n, D:\Archive\", 4, False 
oShell.Run "Explorer /n, D:\Shortcuts\", 4, False

这将打开上次保存位置和大小的文件夹。

注意刚刚在我的Win7机器上测试它并没有用。原来，Win 7不再记住文件夹位置（它只记住大小）。阅读更多相关信息here。

打开窗口左侧和右侧的文件夹

2 个答案: