我正在使用一個較舊的 MS Access 應用程式，其中實作了“在檔案夾中顯示檔案”功能。
此功能使用此基本策略
vPID = Call Shell("explorer.exe /select," & FileFullPathName, vbNormalFocus)
AppActivate vPID
在大多數情況下，這很好用。但是，我有幾個用戶抱怨打開的視窗總是在其他視窗后面。所有有此投訴的用戶都已將他們的機器修補到最新最好的 Windows 10。我已經能夠在類似的機器上復制它。當用戶單擊“在檔案夾中顯示檔案”按鈕時打開多個資源管理器視窗時，該問題最為普遍。
我的各種搜索揭示了幾個聽起來應該可以作業的 Windows API 函式（BringWindowToTop、SetForegroundWindow、SwitchToThisWindow（據我所知已棄用）、SetWindowPos、ShowWindow）。我想我理解這些差異，我應該關注的是BringWindowToTop。
我已經對此進行了許多測驗實作，但最好通過這篇文章的內容來總結它們： 如何將 Windows 資源管理器視窗設定為活動視窗。
目前，我只是忽略了窗戶的清潔度以及用戶可能打開了多少個窗戶等。如果我構造以下內容：
'宣告
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function BringWindowToTop Lib "user32" _
(ByVal hWnd As Long) As Long
'Then set the following up in a button
Dim strFile as String
dim strPath as String
dim strPathSplit() as String
dim lngWindow as Long
strFile = "C:\folder1\folder2\folder3\foo.txt"
strPath = "C:\folder1\folder2\folder3\"
strPathSplit = Split(strPath, "\")
Shell "explorer.exe /select," & strFile, vbNormalFocus
lngWindow = FindWindow("CabinetWClass", strPathSplit(UBound(strPathSplit) - 1))
BringWindowToTop lngWindow
AppActivate strPathSplit(UBound(strPathSplit) - 1)
我從 FindWindow 得到一個非零視窗句柄。但是我用Shell命令打開的資源管理器視窗在后臺固執。它在任務欄上閃爍，但我仍然必須注意到它并單擊它才能將其置于頂部。（當我這樣做時，它確實打開了。）
我已經使用其他 Windows API 函式嘗試了幾種變體，并得到了類似的結果。
如果有人能指出我做錯了什么，或者指出正確的技術來實作這一點，我將不勝感激。我知道在具有類似“在檔案夾中顯示檔案”功能的其他應用程式中很有可能做到這一點，但我也知道那些是用其他語言撰寫的并且可能可以訪問我沒有的功能。
提前致謝！
uj5u.com熱心網友回復：
您沒有檢查BringWindowToTop 的回傳值。你應該這樣做。如果您檢查（某些）函式的回傳值，它會告訴您嘗試失敗。
閃爍的任務欄表示該視窗已被正確通知，但無法將其置于頂部，因為其他一些視窗不會讓它出現。
您對檔案對話框視窗所做的任何事情都不會將它帶到頂部——問題在于它沒有附加到活動行程。
此處描述了成功的條件：https : //docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-setforegroundwindow
如果 Office / Win10 已重新設計為具有此行為，則解決方案是找到具有前臺的行程的句柄，并使用它來創建新對話框，或使用它來釋放焦點并將其推送到后臺，因為兩個行程試圖同時處于前臺是行不通的。
過去，這通常是由用戶在只需要一次時單擊兩次引起的 - 抓住焦點。你應該檢查這沒有發生。
uj5u.com熱心網友回復：
您應該使用條件編譯來檢查您使用的是哪個版本的 Windows 并適當地更改您的宣告。32 位 Windows 處理Long型別與 64 位不同：
#If Win64 Then
Private Declare PtrSafe Function SetForegroundWindow Lib "user32" _
(ByVal hWnd As LongPtr) As LongPtr
#Else
Private Declare Function SetForegroundWindow Lib "user32" _
(ByVal hWnd As Long) As Long
#End If
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
然后看到你已經有了視窗句柄，你可以使用：
SetForegroundWindow lngWindow
uj5u.com熱心網友回復：
因此，正如我在上面的評論中指出的那樣，追求前臺行程身份的建議確實導致了我的困境的答案，但不是通過我最初呼叫的 API 函式。
我最終實作的答案在于 SHOpenFolderAndSelectItems。是的，顯然可以執行此 VB/VBA。fafalone 在此鏈接上發布了一個現有的實作：https ://www.vbforums.com/showthread.php?810301-VB6-Code-Snippet-Open-a-folder-and-select-multiple-files- 探索者中。我也會在這里復制代碼，但正如我所說，它不是我的。
他的功能可以獲取檔案完整路徑的字串陣列，并選擇一個檔案夾中的多個檔案或選擇多個檔案夾中的檔案。如果您想為單個檔案呼叫它（就像我正在做的那樣），您只需將該檔案放入陣列中。然后使用該字串陣列呼叫 OpenFolders 子例程。
在 fafalone 代碼的以下參考中，我沒有對 SierraOscar 指出的條件編譯進行修改，因為它旨在作為直接參考，但我確實在我的實作中這樣做了。它似乎確實有所作為。
fafalone 的代碼是：
Public Type ResultFolder
sPath As String
sFiles() As String
End Type
Public Declare Function SHOpenFolderAndSelectItems Lib "shell32" (ByVal pidlFolder As Long, ByVal cidl As Long, ByVal apidl As Long, ByVal dwFlags As Long) As Long
Public Declare Function ILCreateFromPathW Lib "shell32" (ByVal pwszPath As Long) As Long
Public Declare Function ILFindLastID Lib "shell32" (ByVal pidl As Long) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Public Sub OpenFolders(sFiles() As String)
If sFiles(0) = "" Then Exit Sub 'caller is responsible for ensuring array has been dim'd and contains valid info
Dim tRes() As ResultFolder
Dim apidl() As Long
Dim ppidl As Long
Dim pidlFQ() As Long
Dim i As Long, j As Long
GetResultsByFolder sFiles, tRes
'Now each entry in tRes is a folder, and its .sFiles member contains every file
'in the original list that is in that folder. So for every folder, we now need to
'create a pidl for the folder itself, and an array of all the relative pidls for the
'files. Two helper APIs replace what used to be tons of pidl-related support
'code before XP. After we've got the pidls, they're handed off to the API
For i = 0 To UBound(tRes)
ReDim apidl(UBound(tRes(i).sFiles))
ReDim pidlFQ(UBound(tRes(i).sFiles))
For j = 0 To UBound(tRes(i).sFiles)
pidlFQ(j) = ILCreateFromPathW(StrPtr(tRes(i).sFiles(j))) 'ILCreateFromPathW gives us Unicode support
apidl(j) = ILFindLastID(pidlFQ(j))
Next
ppidl = ILCreateFromPathW(StrPtr(tRes(i).sPath))
Call SHOpenFolderAndSelectItems(ppidl, UBound(apidl) 1, VarPtr(apidl(0)), 0&)
'Vista has dwFlags to start renaming (single file) or select on desktop; there's no valid flags on XP
'now we need to free all the pidls we created, otherwise it's a memory leak
CoTaskMemFree ppidl
For j = 0 To UBound(pidlFQ)
CoTaskMemFree pidlFQ(j) 'per MSDN, child ids obtained w/ ILFindLastID don't need ILFree, so just free FQ
Next
Next
End Sub
Private Sub GetResultsByFolder(sSelFullPath() As String, tResFolders() As ResultFolder)
Dim i As Long
Dim sPar As String
Dim k As Long, cn As Long, fc As Long
ReDim tResFolders(0)
For i = 0 To UBound(sSelFullPath)
sPar = Left$(sSelFullPath(i), InStrRev(sSelFullPath(i), "\") - 1)
k = RFExists(sPar, tResFolders)
If k >= 0 Then 'there's already a file in this folder, so just add a new file to the folders list
cn = UBound(tResFolders(k).sFiles)
cn = cn 1
ReDim Preserve tResFolders(k).sFiles(cn)
tResFolders(k).sFiles(cn) = sSelFullPath(i)
Else 'create a new folder entry
ReDim Preserve tResFolders(fc)
ReDim tResFolders(fc).sFiles(0)
tResFolders(fc).sPath = sPar
tResFolders(fc).sFiles(0) = sSelFullPath(i)
fc = fc 1
End If
Next
End Sub
Private Function RFExists(sPath As String, tResFolders() As ResultFolder) As Long
Dim i As Long
For i = 0 To UBound(tResFolders)
If tResFolders(i).sPath = sPath Then
RFExists = i
Exit Function
End If
Next
RFExists = -1
End Function
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/314232.html