Open and space two folders

[rjplante]

I would like to open two windows folders on the screen and have them appear side by side on the monitor. I have the code below to open both folders and that part works fine. I just need to know how to size them and move one to the left side of the screen and one to the right side of the screen. I want this so that the user and drag and drop from one folder into another.

I have looked for a solution online for this and the one I have found is not compatible with 64 bit machines and have not been tested with Windows 7 and 10.

Thanks for the help!

Sub Final_Transfer()


Dim FinalPath As String
Dim DTPath As String


FinalPath = Sheets("Intro Page").Range("B20").Value
'DTPath = Sheets("Intro Page").Range("AA13").Value


DTPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Active Jobs\"


Application.ScreenUpdating = False


'Asks user to confirm choice.
i = MsgBox("Has all the data been entered into this workbook?", vbYesNo + vbExclamation + vbDefaultButton2)


If i = 7 Then 'NO
    'do some function.
    Application.ScreenUpdating = True
    Exit Sub
ElseIf i = 6 Then 'YES
    Call Shell("explorer.exe " & FinalPath, vbNormalFocus)
    Call Shell("explorer.exe " & DTPath, vbNormalFocus)
    
    Application.ScreenUpdating = True
End If


Application.ScreenUpdating = True


End Sub

 

[John_w]

Try this Open_and_Position_2_Explorer_Windows macro - put all the code in a standard module. I've included your FinalPath and DTPath variables - edit the code where stated, but you'll have to incorporate the rest of your code to ensure the correct folder paths are used.

Code is written for Excel <= 2007 (32-bit) and >= 2010 (32-bit and 64-bit) and Windows 32/64 bit. Tested on Excel 2016 32-bit on Windows 10 (64-bit).

Option Explicit

'http://msdn.microsoft.com/en-us/library/ms724947.aspx
'Values for SystemParametersInfo uAction parameter

Private Const SPI_GETWORKAREA = 48

'http://msdn.microsoft.com/en-us/library/ms633548(VS.85).aspx
'Values for ShowWindow() and WINDOWPLACEMENT nCmdShow parameter

Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Const SW_NORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_MAXIMIZE = 3
Private Const SW_SHOWNOACTIVATE = 4
Private Const SW_SHOW = 5
Private Const SW_MINIMIZE = 6
Private Const SW_SHOWMINNOACTIVE = 7
Private Const SW_SHOWNA = 8
Private Const SW_RESTORE = 9
Private Const SW_SHOWDEFAULT = 10
Private Const SW_FORCEMINIMIZE = 11
Private Const SW_MAX = 11

'http://msdn.microsoft.com/en-us/library/ms632611(VS.85).aspx
'Values for GetWindowPlacement or SetWindowPlacement uFlags parameter

Private Const WPF_SETMINPOSITION = &H1
Private Const WPF_RESTORETOMAXIMIZED = &H2
Private Const WPF_ASYNCWINDOWPLACEMENT = &H4

'http://msdn.microsoft.com/en-us/library/dd162897(VS.85).aspx
'The RECT structure defines the coordinates of the upper-left and lower-right corners of a rectangle

Private Type RECT
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type

Private Type POINT
    x As Long
    y As Long
End Type

'http://msdn.microsoft.com/en-us/library/ms632611(VS.85).aspx
'The WINDOWPLACEMENT structure contains information about the placement of a window on the screen.

Private Type WINDOWPLACEMENT
    length As Long
    flags As Long
    showCmd As Long
    ptMinPosition As POINT
    ptMaxPosition As POINT
    rcNormalPosition As RECT
End Type

'http://msdn.microsoft.com/en-us/library/ms632610(VS.85).aspx
'The WINDOWINFO structure contains window information.

Private Type WINDOWINFO
    cbSize As Long
    rcWindow As RECT
    rcClient As RECT
    dwStyle As Long
    dwExStyle As Long
    dwWindowStatus As Long
    cxWindowBorders As Long
    cyWindowBorders As Long
    atomWindowType As Integer
    wCreatorVersion As Integer
End Type


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then

    'New VBA version 7 compiler, therefore >= Office 2010
    'PtrSafe means function works in 32-bit and 64-bit Office
    'LongPtr type alias resolves to Long (32 bits) in 32-bit Office, or LongLong (64 bits) in 64-bit Office
    
    Private Declare PtrSafe Sub Sleep Lib "kernel32" _
        (ByVal dwMilliseconds As Long)
    Private Declare PtrSafe Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
        (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
    Private Declare PtrSafe Function GetWindowPlacement Lib "user32" _
        (ByVal hWnd As LongPtr, lpwndpl As WINDOWPLACEMENT) As Long
    Private Declare PtrSafe Function SetWindowPlacement Lib "user32" _
        (ByVal hWnd As LongPtr, ByRef lpwndpl As WINDOWPLACEMENT) As Long
    Private Declare PtrSafe Function GetWindowInfo Lib "user32" _
        (ByVal hWnd As LongPtr, ByRef pwi As WINDOWINFO) As Long

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 

    'Old VBA version 6 or earlier compiler, therefore <= Office 2007
    
    Private Declare Sub Sleep Lib "kernel32" _
        (ByVal dwMilliseconds As Long)
    Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
        (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
    Private Declare Function GetWindowPlacement Lib "user32" _
        (ByVal hWnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
    Private Declare Function SetWindowPlacement Lib "user32" _
        (ByVal hWnd As Long, ByRef lpwndpl As WINDOWPLACEMENT) As Long
    Private Declare Function GetWindowInfo Lib "user32" _
        (ByVal hWnd As Long, ByRef pwi As WINDOWINFO) As Long

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If


Public Sub Open_and_Position_2_Explorer_Windows()

    Dim FinalPath As String, DTPath As String
    Dim screenWidth As Long, screenHeight As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Dim hWnd As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Dim hWnd As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    
    Get_Screen_Size screenWidth, screenHeight
    Debug.Print "Screen width and height: " & screenWidth, screenHeight
    
    'Open 1st Explorer folder and place window at top left of screen and resize to half width of screen and 500 pixels high
    
    FinalPath = "C:\folder\path1"                          ' CHANGE THIS
    Shell "explorer.exe " & Q(FinalPath), vbNormalFocus
    DoEvents
    Sleep 1000
    hWnd = Get_Explorer_hWnd(FinalPath)
    Place_Window hWnd, 0, 0, Int(screenWidth / 2), 500
    
    'Open 2nd Explorer folder and place window at top of screen and half width of screen from left and resize to half width of screen and 500 pixels high
    
    DTPath = "C:\folder\path2"                          ' CHANGE THIS
    Shell "explorer.exe " & Q(DTPath), vbNormalFocus
    DoEvents
    Sleep 1000
    hWnd = Get_Explorer_hWnd(DTPath)
    Place_Window hWnd, Int(screenWidth / 2) + 1, 0, Int(screenWidth / 2), 500
        
End Sub


Private Function Q(text As String) As String
    Q = Chr(34) & text & Chr(34)
End Function


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
Private Function Get_Explorer_hWnd(ByVal folderPath As String) As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
Private Function Get_Explorer_hWnd(ByVal folderPath As String) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

    'Look for a File Explorer window open at the specified folder and, if found, return its hWnd.  Otherwise return zero.

    Dim Shell As Object
    Dim DocVw As Object 'SHDocVw.InternetExplorer
    Dim i As Variant    'Must be a Variant to index Shell.Windows.Item() array
    
    Set Shell = CreateObject("Shell.Application")
    
    Debug.Print "Path = " & "file:///" & Replace(folderPath, "", "/")
    
    i = 0
    Get_Explorer_hWnd = 0
    While i < Shell.Windows.Count And Get_Explorer_hWnd = 0
        Set DocVw = Shell.Windows.Item(i)
        If Not DocVw Is Nothing Then
            Debug.Print "LocationURL = " & DocVw.LocationURL
            Debug.Print "LocationName = " & DocVw.LocationName
            Debug.Print "Name = " & DocVw.Name
            Debug.Print "hWnd = " & DocVw.hWnd
            If DocVw.Name = "File Explorer" And StrComp(DocVw.LocationURL, "file:///" & Replace(folderPath, "", "/"), vbTextCompare) = 0 Then
                Get_Explorer_hWnd = DocVw.hWnd
            End If
        End If
        i = i + 1
    Wend
    
End Function


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
Private Sub Place_Window(hWnd As LongPtr, left As Long, top As Long, width As Long, height As Long)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
Private Sub Place_Window(hWnd As Long, left As Long, top As Long, width As Long, height As Long)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

    Dim ret As Long
    Dim wplace As WINDOWPLACEMENT
    Dim changePlacement As Boolean
    
    'Get the window's current position and size
    
    wplace.length = LenB(wplace)
    ret = GetWindowPlacement(hWnd, wplace)
    If ret = 0 Then
        Debug.Print "GetWindowPlacement error:"; Err.LastDllError
    End If
    
    Debug.Print "Current placement: " & wplace.rcNormalPosition.left & "," & wplace.rcNormalPosition.top & _
                "   " & wplace.rcNormalPosition.right & "," & wplace.rcNormalPosition.bottom

    'Set new position and size only if it needs changing
    
    If wplace.rcNormalPosition.left <> left Or _
        wplace.rcNormalPosition.top <> top Or _
        wplace.rcNormalPosition.right <> wplace.rcNormalPosition.left + width Or _
        wplace.rcNormalPosition.bottom <> wplace.rcNormalPosition.top + height Then
           
        'Set up the WINDOWPLACEMENT data structure with coordinates of the window's top-left and
        'bottom-right corners in its restored position
        
        wplace.length = LenB(wplace)
        wplace.showCmd = SW_SHOWNORMAL
        
        changePlacement = False
        If left >= 0 Then
            wplace.rcNormalPosition.left = left
            changePlacement = True
        End If
        If top >= 0 Then
            wplace.rcNormalPosition.top = top
            changePlacement = True
        End If
        If width >= 0 Then
            wplace.rcNormalPosition.right = wplace.rcNormalPosition.left + width
            changePlacement = True
        End If
        If height >= 0 Then
            wplace.rcNormalPosition.bottom = wplace.rcNormalPosition.top + height
            changePlacement = True
        End If
        
        If changePlacement Then
        
            Debug.Print "New placement: " & wplace.rcNormalPosition.left & "," & wplace.rcNormalPosition.top & _
                "   " & wplace.rcNormalPosition.right & "," & wplace.rcNormalPosition.bottom
            
            'Set the window's new position and size
            
            ret = SetWindowPlacement(hWnd, wplace)
            If ret = 0 Then
                Debug.Print "SetWindowPlacement error:"; Err.LastDllError
            End If
            
        End If
    
    Else
        
        Debug.Print "Already in required position, therefore repositioning unnecessary"
        
    End If
    
End Sub


Private Sub Get_Screen_Size(ByRef width As Long, ByRef height As Long)

    Dim ret As Long
    Dim workarea As RECT

    'http://msdn.microsoft.com/en-us/library/ms724947.aspx
    'Get the size of the work area on the primary display monitor.  The work area is the portion of
    'the screen not obscured by the system taskbar or by application desktop toolbars.
    'The windows will be sized and tiled within this area, regardless of the position of the system
    'taskbar.
    
    ret = SystemParametersInfo(SPI_GETWORKAREA, 0&, workarea, 0&)
    If ret = 0 Then
        Debug.Print Err.LastDllError
    End If
   
    'Max width and height depends on workarea
    
    width = workarea.right - workarea.left
    height = workarea.bottom - workarea.top

End Sub

 

[John_w]

The forum software has removed the back slashes from the Get_Explorer_hWnd function. Here is the function with BACK SLASH in place of them, which you must replace with a back slash character.

#If VBA7 Then
Private Function Get_Explorer_hWnd(ByVal folderPath As String) As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
Private Function Get_Explorer_hWnd(ByVal folderPath As String) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

    'Look for a File Explorer window open at the specified folder and, if found, return its hWnd.  Otherwise return zero.

    Dim Shell As Object
    Dim DocVw As Object 'SHDocVw.InternetExplorer
    Dim i As Variant    'Must be a Variant to index Shell.Windows.Item() array
    
    Set Shell = CreateObject("Shell.Application")
    
    Debug.Print "Path = " & "file:///" & Replace(folderPath, "BACK SLASH", "/")  'FIX THIS
    
    i = 0
    Get_Explorer_hWnd = 0
    While i < Shell.Windows.Count And Get_Explorer_hWnd = 0
        Set DocVw = Shell.Windows.Item(i)
        If Not DocVw Is Nothing Then
            Debug.Print "LocationURL = " & DocVw.LocationURL
            Debug.Print "LocationName = " & DocVw.LocationName
            Debug.Print "Name = " & DocVw.Name
            Debug.Print "hWnd = " & DocVw.hWnd
            If DocVw.Name = "File Explorer" And StrComp(DocVw.LocationURL, "file:///" & Replace(folderPath, "BACK SLASH", "/"), vbTextCompare) = 0 Then 'FIX THIS
                Get_Explorer_hWnd = DocVw.hWnd
            End If
        End If
        i = i + 1
    Wend
    
End Function

 

[rjplante]

I have copied and added your code to a new standard module, changed the necessary backslashes, and updated the file paths to reflect what I need them to be. When I run the macro, it opens the correct folders, but they are stacked right on top of one another, but offset by about a half an inch. They are not separated one on the left side and one on the right. The size of the windows also will not allow then to fit side by side on the screen. I don't know how to edit the code to specify the size of the windows, nor how to make sure they don't overlap. I appreciate your help in getting me this far. Please help me get past the finish line. I feel we are close. Just another quick note, I have a laptop with two additional monitors hooked up to it. One of the large monitors serves as my main screen. When the final end user runs this macro they will also be on a laptop, but they will not have any other monitors connected. I don't know if the multiple monitor issue complicated the output operation of the macro.

Thanks for the help.

 

[John_w]

The size and position of the windows are specified in screen pixels in the Place_Window arguments:

Private Sub Place_Window(hWnd As LongPtr, left As Long, top As Long, width As Long, height As Long)

left is the number of pixels from the left of the screen and top is the number of pixels from the top of the screen. Origin (0,0) is the top left of the screen.

In my code, the first explorer window is placed at the top left of the screen and is half the screen width and 500 pixels high:

    Place_Window hWnd, 0, 0, Int(screenWidth / 2), 500

The second window should be placed to the right, occupying the right hand side of the screen. Try different numbers for those arguments.

Something in the code isn't working if the windows are on top of each other. The code works for me in Excel 32-bit on Windows 10 (which is 64-bit). Is your Excel a 32-bit installation or 64-bit? Multiple monitors could well be the issue - have you tried it on a single monitor? I tested on a single monitor, but don't have dual monitors to test.

 

[rjplante]

I finally had the chance to try the macro on a laptop with no other monitors connected and it does the same thing. Opens both folders correctly, but stacks them on top of one another. Any other thoughts?