Microsoft 365 Recherche Windows par VBA

[LUMBARDO]

Bonjour,

Je souhaite lancer une recherche Windows (2008) à partir d'un Useform.

J'ai deux possibilités :
1)
Dim objShell As Shell
Dim moi As String

Set objShell = New Shell
objShell.Explore ("C:\Users\xxxx\yyyy\En cours")
2)
Dim chemin As String
Dim fichier As String

chemin = ("C:\Users\xxxx\yyyy\En cours")
Shell Environ("WINDIR") & "\explorer.exe " & chemin, vbMaximizedFocus

La difficulté commence lorsque je souhaite aller plus loin en ajoutant une variable que je tente d'ajouter au chemin avec & + combobox déclaré en variable.
En effet, la variable est un numéro de 10 positions situées en début des dossiers que je souhaite ouvrir et ne constituent qu'une partie de son nom .
En résumé :
Actuellement j'arrive là :

et je souhaiterais arriver là :

Sans aller plus loin.

Quelqu'un sait il si c'est possible (sachant que c'est tout type de dossier .pdf, xlm, etc ?

PS : J'ai écumé en vain le site à la recherche d'une situation proche.

 

[Staple1600]

Bonsoir le fil, LUMBARDO

=>LUMBARDO

Est-ce que dans l'écume, tu étais tombé sur ce fil

VBA et Windows Desktop Search...

[Résolu] - VBA et Windows Desktop Search... Bonjour le forum XLD, Je recherche des fichiers sur mon réseau professionnel avec la commande Application.FileSearch dans un répertoire contenant une arborescence de près de 12000 dossiers... La recherche d'un fichier prend souvent entre 1 et 2...

www.excel-downloads.com

ou celle-ci

Recherche dans l'explorateur windows

Bonjour à tous, Avec une macro je souhaite copier la cellule active dans le presse papier et la coller dans la recherche de l'explorateur Windows 7 copier: je sais faire '----- copier dans le presse papier Dim TheData As String TheData = libelle With New DataObject...

www.excel-downloads.com

Peut-être quelques pistes à glaner, qui sait?

 

[LUMBARDO]

Slt Staple,
Merci.
J'ai tenté d'adapter la méthode 2 (avec copie dans le presse papier) mais il n'aime pas les variables et lance la recherche sur le mot le mot dossier. Donc je continue à chercher.

 

[Staple1600]

Re

[aparté]
Sinon, pas de feedback sur ceci?
[/aparté]

 

[LUMBARDO]

Bonjour Staple,

Objectif atteint avec ce code :

Declare PtrSafe Sub ClientToScreen Lib "user32" _ (ByVal hwnd As Long, lpPoint As POINT)
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As tring, _ ByVal lpWindowName As String) As Long
Declare PtrSafe Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" ( ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _ ByVal lpsz2 As String) As Long
Declare PtrSafe Sub keybd_event Lib "user32.dll" _
(ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Declare PtrSafe Sub mouse_event Lib "user32" _
(ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, _
ByVal cButtons As Long, ByVal dwExtraInfo As Long)

Declare PtrSafe Function SetCursorPos Lib "user32" _
(ByVal x As Long, ByVal y As Long) As Long

Declare PtrSafe 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

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long

Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long

Declare PtrSafe Function CloseClipboard Lib "user32" () As Long

Const SW_NORMAL As Long = 1
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const KEYEVENTF_KEYUP = &H2
Const VK_CONTROL As Long = &H11
Const VK_C = 67
Const VK_V = 86

Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Type POINT
x As Long
y As Long

Private Sub CommandButton65_Click()
Dim DataObj As New MSForms.DataObject
Dim Mon_texte As String
Dim RetVal As Long

ClearClipboard 'on vide le presse-papier

'on ouvre l'explorateur Windows
RetVal = ShellExecute(0, "open", "explorer.exe", "C:\Users\xxxx\Documents\dossiers", 0, SW_NORMAL)
Sleep 1000

If RetVal = 2 Or RetVal = 3 Then
MsgBox "Chemin ou fichier non trouvé"
Exit Sub
End If

'on copie le texte de la cellule active dans le presse-papier

Mon_texte = Me.ComboBox2.Value (variable)
DataObj.SetText Mon_texte
DataObj.PutInClipboard

Sleep 500

'on se place dans la fenêtre de saisie y pour coller le contenu du presse-papier
SendKeys String:="{F3}", wait:=True
keybd_event VK_CONTROL, 0, 0, 0
keybd_event VK_V, 0, 0, 0
keybd_event VK_V, 0, KEYEVENTF_KEYUP, 0
keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0
keybd_event VK_CONTROL, 0, 0, 0
keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0
Sleep 1000
SendKeys String:="{ENTER}", wait:=True

With Application
DoEvents
Application.SendKeys ("{NUMLOCK}"), True
End With

End Sub[/CODE]

Merci encore pour ton sens de l'orientation.

 

[LUMBARDO]

Bonjour Staple,

Objectif atteint avec ce code :

Declare PtrSafe Sub ClientToScreen Lib "user32" _ (ByVal hwnd As Long, lpPoint As POINT)
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As tring, _ ByVal lpWindowName As String) As Long
Declare PtrSafe Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" ( ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _ ByVal lpsz2 As String) As Long
Declare PtrSafe Sub keybd_event Lib "user32.dll" _
(ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Declare PtrSafe Sub mouse_event Lib "user32" _
(ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, _
ByVal cButtons As Long, ByVal dwExtraInfo As Long)

Declare PtrSafe Function SetCursorPos Lib "user32" _
(ByVal x As Long, ByVal y As Long) As Long

Declare PtrSafe 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

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long

Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long

Declare PtrSafe Function CloseClipboard Lib "user32" () As Long

Const SW_NORMAL As Long = 1
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const KEYEVENTF_KEYUP = &H2
Const VK_CONTROL As Long = &H11
Const VK_C = 67
Const VK_V = 86

Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Type POINT
x As Long
y As Long

Private Sub CommandButton65_Click()
Dim DataObj As New MSForms.DataObject
Dim Mon_texte As String
Dim RetVal As Long

ClearClipboard 'on vide le presse-papier

'on ouvre l'explorateur Windows
RetVal = ShellExecute(0, "open", "explorer.exe", "C:\Users\xxxx\Documents\dossiers", 0, SW_NORMAL)
Sleep 1000

If RetVal = 2 Or RetVal = 3 Then
MsgBox "Chemin ou fichier non trouvé"
Exit Sub
End If

'on copie le texte de la cellule active dans le presse-papier

Mon_texte = Me.ComboBox2.Value (variable)
DataObj.SetText Mon_texte
DataObj.PutInClipboard

Sleep 500

'on se place dans la fenêtre de saisie y pour coller le contenu du presse-papier
SendKeys String:="{F3}", wait:=True
keybd_event VK_CONTROL, 0, 0, 0
keybd_event VK_V, 0, 0, 0
keybd_event VK_V, 0, KEYEVENTF_KEYUP, 0
keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0
keybd_event VK_CONTROL, 0, 0, 0
keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0
Sleep 1000
SendKeys String:="{ENTER}", wait:=True

With Application
DoEvents
Application.SendKeys ("{NUMLOCK}"), True
End With

End Sub[/CODE]

Merci encore pour ton sens de l'orientation.

Re

[aparté]
Sinon, pas de feedback sur ceci?
[/aparté]

Bonsoir Staple,
Vous m'aviez guidé pour l'ouverture du fichier à partir d'un code.
Visiblement j'ai subi une modification de Windows car depuis il copie dans le presse papier un petit rectangle...

Avez-vous une idée ?