vba, открытие папки определенного размера в определенном месте на экране

[Puffi.Muffi]

Всем привет!

Подскажите, пожалуйста, возможно ли открыть папку в определенном месте на экране и задать ей нужный размер?

Все что у меня имеется:

Shell ("explorer.exe /,""C:\адрес папки"), vbNormalFocus

Возможно ли задать какие-либо дополнительные параметры?
Или как-нибудь по другому это сделать на vba?

[maksim_serg]

да, возможно. WinApi в помощь

[Puffi.Muffi]

Maksim_Serg, а вы пробовали?

[doober]

Сообщение от Puffi.Muffi

Maksim_Serg, а вы пробовали?

Зачем пробовать,если это так.
В помощь вам имя класса окна CabinetWClass,caption в вашем случае= адрес папки.
У каждого окна есть координаты на экране,ширина,высота.
Управляйте ими через функции АПИ.
Только есть ли в этом такая необходимость?
Если реализуете это,то выучите АПИ на 5 баллов,это точно.

[Puffi.Muffi]

Спасибо.

Задумка очень простая:
Написан код:
По определенным критериям большое количество файлов сохраняются в разные папки под новыми названиями.
Хотелось бы, чтобы после сохранения сразу были видны все папки с новыми файлами (т.е. расположены по площади экрана).

буду разбираться...

[Puffi.Muffi]

Нашелся подходящий код в книжке "Professional Access 2013 Programming":

'Step 1: Get the Desktop Window Handle
Private Declare PtrSafe Function apiGetDesktopWindow _
Lib "User32" Alias "GetDesktopWindow" () As LongPtr

'Step 2: Declare the Sleep API
Private Declare PtrSafe Sub Sleep Lib "Kernel32" (ByVal ms As Long)

'Step 3: Declare the EnumChildWindows API
Private Declare PtrSafe Function apiEnumChildWindows _
Lib "User32" Alias "EnumChildWindows" _
(ByVal hWndParent As LongPtr, ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long

'Step 5: Declare the GetClassName API
Private Declare PtrSafe Function apiGetClassName Lib "User32" _
Alias "GetClassNameA" _
(ByVal hWnd As LongPtr, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long

'Step 7: Define the module-level Contsants and Variables
Const ECP_GETEXISTING = 1
Const ECP_GETNEW = 2
Private m_ExistingExplorers As String
Private m_NewExplorer As LongPtr

'Task 2 - Steps 11 through 14 - Place the Explorer window


'Step 11: Define the UDTs required by the WindowPlacement API
'This step immediately follows testing your code.

Public Type apiPOINT
X As Long
Y As Long
End Type

Public Type apiRECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Public Type apiWINDOWPLACEMENT
length As Long
flags As Long
ShowCmd As Long
ptMinPosition As apiPOINT
ptMaxPosition As apiPOINT
rcNormalPostion As apiRECT
End Type

'Step 12: Declare the GetWindowPlacement and SetWindowPlacement APIs
Private Declare PtrSafe Function apiGetWindowPlacement _
Lib "User32" Alias "GetWindowPlacement" _
(ByVal hWnd As LongPtr, lpwndpl As apiWINDOWPLACEMENT) As Long

Private Declare PtrSafe Function apiSetWindowPlacement _
Lib "User32" Alias "SetWindowPlacement" _
(ByVal hWnd As LongPtr, lpwndpl As apiWINDOWPLACEMENT) As Long

'Step 13: Create the PlaceWindow procedure
Private Sub PlaceWindow( _
hWnd As LongPtr, Top As Long, Left As Long, Bottom As Long, Right As Long)
Dim wp As apiWINDOWPLACEMENT
wp.length = Len(wp)
apiGetWindowPlacement hWnd, wp
With wp
.rcNormalPostion.Top = Top
.rcNormalPostion.Left = Left
.rcNormalPostion.Bottom = Bottom
.rcNormalPostion.Right = Right
End With
apiSetWindowPlacement hWnd, wp
End Sub

'Step 4: Declare the EnumChildProc callback
Public Function ECPGetExplorer( _
ByVal hWnd As LongPtr, ByVal lParam As Long) As Long

'Step 8: Fill the EnumChildProc callback with logic
Dim ret As Long
ret = -1
If lParam = ECP_GETEXISTING Then

If (Classname(hWnd) = "CabinetWClass") Or _
(Classname(hWnd) = "ExploreWClass") Then
m_ExistingExplorers = m_ExistingExplorers & ";" & CStr(hWnd) & ";"
End If
ElseIf lParam = ECP_GETNEW Then
If (Classname(hWnd) = "CabinetWClass") Or _
(Classname(hWnd) = "ExploreWClass") Then

If InStr(1, ";" & Classname(hWnd) & ";", m_ExistingExplorers & ";") = 0 Then
m_NewExplorer = hWnd
ret = 0
End If
End If
End If
ECPGetExplorer = ret
End Function

'Step 6: Write the GetClassName Wrapper
Private Function Classname(hWnd As LongPtr) As String
Dim s As String
s = String(255, 0)
apiGetClassName hWnd, s, 255
Classname = Replace(s, Chr(0), "")
End Function

'Step 9: Create the main OpenAndPlaceExplorer procedure
Public Sub OpenAndPlaceExplorer()
Dim hWndDesktop As LongPtr

hWndDesktop = apiGetDesktopWindow()
apiEnumChildWindows hWndDesktop, AddressOf ECPGetExplorer, ECP_GETEXISTING

'Shell "Explorer.exe", vbNormalFocus
Sleep 500
apiEnumChildWindows hWndDesktop, AddressOf ECPGetExplorer, ECP_GETNEW

'Step 10: Stop and test your code
Debug.Print "Existing Explorer Handles: " & m_ExistingExplorers
Debug.Print "New Explorer Handle: " & m_NewExplorer

'Step 14: Add the call from OpenAndPlaceExplorer to PlaceWindow and
' clean up the module-level variables
PlaceWindow m_NewExplorer, 200, 200, 800, 800

m_ExistingExplorers = ""
m_NewExplorer = 0

End Sub

[maksim_serg]

Нашелся подходящий код в книжке "Professional Access 2013 Programming":

как то сложно...

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpCaption As String) As Long
Private Declare Sub Sleep Lib "Kernel32" (ByVal ms As Long)
Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
Declare Function SetWindowPos Lib "user32" _
         (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
         
Sub v()
    Dim WindowsTitle(3) As String
    Dim WindoesHandle(3) As Long
    Dim x, y, w, h As Integer
    
    WindowsTitle(0) = "C:\Program Files"
    WindowsTitle(1) = "C:\Windows"
    WindowsTitle(2) = "C:\Windows\System32"
    WindowsTitle(3) = "C:\Windows\Web"
    For i = 0 To UBound(WindowsTitle)
        Call Shell("explorer.exe " & WindowsTitle(i), 1)
    Next
    Sleep 1000
    For i = 0 To UBound(WindowsTitle)
        WindoesHandle(i) = FindWindow(vbNullString, Mid(WindowsTitle(i), InStrRev(WindowsTitle(i), "\") + 1))
    Next
    
    For i = 0 To UBound(WindowsTitle)
        'осталось только подобрать координаты и размеры окна
        Call SetWindowPos(WindoesHandle(i), 0, x, y, 500, 300, 0)
        w = w + 500
        If w > GetSystemMetrics(0) - 500 Then
            w = 0: x = 0: y = y + 300
        Else
            x = x + 500
        End If
    Next

End Sub

[Puffi.Muffi]

Согласна, спасибо

[ABA2]

Хорошый код,пригадитса.Спасибо.А как его подправить,штоб можно было его пустить с *vbs скрипта ?