web-dev-qa-db-fra.com

Comment ouvrir un dossier dans Windows Explorer à partir de VBA?

Je veux cliquer sur un bouton de mon formulaire d'accès qui ouvre un dossier dans l'Explorateur Windows.

Est-il possible de faire cela dans VBA?

ms-accessvba
35
VBwhatnow

Vous pouvez utiliser le code suivant pour ouvrir un emplacement de fichier à partir de vba.

Dim Foldername As String
Foldername = "\\server\Instructions\"

Shell "C:\WINDOWS\Explorer.exe """ & Foldername & "", vbNormalFocus

Vous pouvez utiliser ce code pour les partages Windows et les lecteurs locaux.

VbNormalFocus peut être swapper pour VbMaximizedFocus si vous souhaitez une vue agrandie.

38
VBwhatnow

Le plus simple est

Application.FollowHyperlink [path]

Ce qui ne prend qu'une ligne!

17
Brian Battles

Voici quelques connaissances plus intéressantes pour aller avec ceci:

Je me trouvais dans une situation où je devais être capable de trouver des dossiers en fonction de critères définis dans l'enregistrement puis d'ouvrir le ou les dossiers trouvés. Tout en cherchant une solution, j’ai créé une petite base de données qui demande un dossier de départ pour la recherche et qui donne une place à 4 éléments de critères, puis permet à l’utilisateur de faire des critères de correspondance pour ouvrir les 4 (ou plus) dossiers possibles correspondant aux éléments entrés. Critères.

Voici le code complet sur le formulaire:

Option Compare Database
Option Explicit

Private Sub cmdChooseFolder_Click()

    Dim inputFileDialog As FileDialog
    Dim folderChosenPath As Variant

    If MsgBox("Clear List?", vbYesNo, "Clear List") = vbYes Then DoCmd.RunSQL "DELETE * FROM tblFileList"
    Me.sfrmFolderList.Requery

    Set inputFileDialog = Application.FileDialog(msoFileDialogFolderPicker)

    With inputFileDialog
        .Title = "Select Folder to Start with"
        .AllowMultiSelect = False
        If .Show = False Then Exit Sub
        folderChosenPath = .SelectedItems(1)
    End With

    Me.txtStartPath = folderChosenPath

    Call subListFolders(Me.txtStartPath, 1)

End Sub
Private Sub cmdFindFolderPiece_Click()

    Dim strCriteria As String
    Dim varCriteria As Variant
    Dim varIndex As Variant
    Dim intIndex As Integer

    varCriteria = Array(Nz(Me.txtSerial, "Null"), Nz(Me.txtCustomerOrder, "Null"), Nz(Me.txtAXProject, "Null"), Nz(Me.txtWorkOrder, "Null"))
    intIndex = 0

    For Each varIndex In varCriteria
        strCriteria = varCriteria(intIndex)
        If strCriteria <> "Null" Then
            Call fnFindFoldersWithCriteria(TrailingSlash(Me.txtStartPath), strCriteria, 1)
        End If
        intIndex = intIndex + 1
    Next varIndex

    Set varIndex = Nothing
    Set varCriteria = Nothing
    strCriteria = ""

End Sub
Private Function fnFindFoldersWithCriteria(ByVal strStartPath As String, ByVal strCriteria As String, intCounter As Integer)

    Dim fso As New FileSystemObject
    Dim fldrStartFolder As Folder
    Dim subfldrInStart As Folder
    Dim subfldrInSubFolder As Folder
    Dim subfldrInSubSubFolder As String
    Dim strActionLog As String

    Set fldrStartFolder = fso.GetFolder(strStartPath)

'    Debug.Print "Criteria: " & Replace(strCriteria, " ", "", 1, , vbTextCompare) & " and Folder Name is " & Replace(fldrStartFolder.Name, " ", "", 1, , vbTextCompare) & " and Path is: " & fldrStartFolder.Path

    If fnCompareCriteriaWithFolderName(fldrStartFolder.Name, strCriteria) Then
'        Debug.Print "Found and Opening: " & fldrStartFolder.Name & "Because of: " & strCriteria
        Shell "Explorer.EXE" & " " & Chr(34) & fldrStartFolder.Path & Chr(34), vbNormalFocus
    Else
        For Each subfldrInStart In fldrStartFolder.SubFolders

            intCounter = intCounter + 1

            Debug.Print "Criteria: " & Replace(strCriteria, " ", "", 1, , vbTextCompare) & " and Folder Name is " & Replace(subfldrInStart.Name, " ", "", 1, , vbTextCompare) & " and Path is: " & fldrStartFolder.Path

            If fnCompareCriteriaWithFolderName(subfldrInStart.Name, strCriteria) Then
'                Debug.Print "Found and Opening: " & subfldrInStart.Name & "Because of: " & strCriteria
                Shell "Explorer.EXE" & " " & Chr(34) & subfldrInStart.Path & Chr(34), vbNormalFocus
            Else
                Call fnFindFoldersWithCriteria(subfldrInStart, strCriteria, intCounter)
            End If
            Me.txtProcessed = intCounter
            Me.txtProcessed.Requery
        Next
    End If

    Set fldrStartFolder = Nothing
    Set subfldrInStart = Nothing
    Set subfldrInSubFolder = Nothing
    Set fso = Nothing

End Function
Private Function fnCompareCriteriaWithFolderName(strFolderName As String, strCriteria As String) As Boolean

    fnCompareCriteriaWithFolderName = False

    fnCompareCriteriaWithFolderName = InStr(1, Replace(strFolderName, " ", "", 1, , vbTextCompare), Replace(strCriteria, " ", "", 1, , vbTextCompare), vbTextCompare) > 0

End Function

Private Sub subListFolders(ByVal strFolders As String, intCounter As Integer)
    Dim dbs As Database
    Dim fso As New FileSystemObject
    Dim fldFolders As Folder
    Dim fldr As Folder
    Dim subfldr As Folder
    Dim sfldFolders As String
    Dim strSQL As String

    Set fldFolders = fso.GetFolder(TrailingSlash(strFolders))
    Set dbs = CurrentDb

    strSQL = "INSERT INTO tblFileList (FilePath, FileName, FolderSize) VALUES (" & Chr(34) & fldFolders.Path & Chr(34) & ", " & Chr(34) & fldFolders.Name & Chr(34) & ", '" & fldFolders.Size & "')"
    dbs.Execute strSQL

    For Each fldr In fldFolders.SubFolders
        intCounter = intCounter + 1
        strSQL = "INSERT INTO tblFileList (FilePath, FileName, FolderSize) VALUES (" & Chr(34) & fldr.Path & Chr(34) & ", " & Chr(34) & fldr.Name & Chr(34) & ", '" & fldr.Size & "')"
        dbs.Execute strSQL
        For Each subfldr In fldr.SubFolders
            intCounter = intCounter + 1
            sfldFolders = subfldr.Path
            Call subListFolders(sfldFolders, intCounter)
            Me.sfrmFolderList.Requery
        Next
        Me.txtListed = intCounter
        Me.txtListed.Requery
    Next

    Set fldFolders = Nothing
    Set fldr = Nothing
    Set subfldr = Nothing
    Set dbs = Nothing

End Sub

Private Function TrailingSlash(varIn As Variant) As String
    If Len(varIn) > 0& Then
        If Right(varIn, 1&) = "\" Then
            TrailingSlash = varIn
        Else
            TrailingSlash = varIn & "\"
        End If
    End If
End Function

Le formulaire comporte un sous-formulaire basé sur la table. Le formulaire comporte 4 zones de texte pour les critères, 2 boutons menant aux procédures de clic et 1 autre zone de texte permettant de stocker la chaîne pour le dossier de départ. Deux zones de texte sont utilisées pour indiquer le nombre de dossiers répertoriés et le nombre traité lors de la recherche des critères.

Si j'avais le représentant, je posterais une photo ...: /

J'ai quelques autres choses que je voulais ajouter à ce code mais je n'ai pas encore eu la chance. Je veux avoir un moyen de stocker ceux qui ont fonctionné dans une autre table ou d'amener l'utilisateur à les marquer comme bons à stocker.

Je ne peux pas réclamer le plein crédit pour tout le code, j'en ai bricolé une partie de ce que j'ai trouvé tout autour, même dans d'autres articles sur stackoverflow.

J'aime beaucoup l'idée de poster des questions ici, puis d'y répondre vous-même, car comme le dit l'article lié, il est facile de trouver la réponse pour une référence ultérieure.

Lorsque je terminerai les autres parties que je veux ajouter, je posterai également le code correspondant. :)

7
DawnTreader

Grâce au commentaire de PhilHibbs (sur la réponse de VBwhatnow), j'ai finalement réussi à trouver une solution qui réutilise les fenêtres existantes et évite de faire clignoter une fenêtre CMD chez l'utilisateur:

Dim path As String
path = CurrentProject.path & "\"
Shell "cmd /C start """" /max """ & path & """", vbHide

où 'chemin' est le dossier que vous voulez ouvrir.

(Dans cet exemple, j'ouvre le dossier dans lequel le classeur actuel est enregistré.)

Avantages:

  • Évite d'ouvrir de nouvelles instances de l'explorateur (ne définit le focus que si la fenêtre existe).
  • La fenêtre de commande est jamais visible grâce à vbHide.
  • Relativement simple (il n'est pas nécessaire de faire référence aux bibliothèques win32).

Inconvénients:

  • La maximisation (ou la minimisation) de la fenêtre est obligatoire.

Explication:

Au début, j'ai essayé d'utiliser uniquement vbHide. Cela fonctionne bien ... sauf si un tel dossier est déjà ouvert, auquel cas la fenêtre du dossier existant est masquée et disparaît! Vous avez maintenant un fantôme Une fenêtre flottant dans la mémoire et toute tentative ultérieure d'ouvrir le dossier après la réutilisation de la fenêtre masquée n'auront apparemment aucun effet.

En d'autres termes, lorsque la commande 'start' trouve une fenêtre existante, le vbAppWinStyle spécifié est appliqué à la fois à la fenêtre CMD et à la fenêtre de l'Explorateur réutilisée. (Heureusement, nous pouvons utiliser cela pour dé-masquer notre fenêtre fantôme en appelant à nouveau la même commande avec un argument vbAppWinStyle différent.)

Cependant, en spécifiant les indicateurs/max ou/min lors de l'appel de "start", cela empêche l'application vbAppWinStyle définie dans la fenêtre CMD d'être appliquée de manière récursive. (Ou le remplace? Je ne sais pas quels sont les détails techniques et je suis curieux de savoir exactement quelle est la chaîne d'événements.)

6
AnorZaken

Voici ce que j'ai fait.

Dim strPath As String
strPath = "\\server\Instructions\"    
Shell "cmd.exe /c start """" """ & strPath & """", vbNormalFocus

Avantages:

  • Évite d'ouvrir de nouvelles instances de l'Explorateur (ne définit le focus que si la fenêtre existe).
  • Relativement simple (il n'est pas nécessaire de faire référence aux bibliothèques win32).
  • La maximisation (ou la minimisation) de la fenêtre est not obligatoire. La fenêtre s'ouvrira avec une taille normale.

Inconvénients:

  • La fenêtre de commande est visible pendant un court instant.

Cela ouvre systématiquement une fenêtre sur le dossier si aucun dossier n'est ouvert et bascule vers la fenêtre ouverte s'il en existe une ouverte sur ce dossier.

Merci à PhilHibbs et AnorZaken pour les bases. Le commentaire de PhilHibbs ne fonctionnait pas très bien pour moi. J'avais besoin de la chaîne de commande pour avoir une paire de guillemets avant le nom du dossier. Et je préférais avoir une fenêtre d'invite de commande apparaître pendant un moment plutôt que d'être obligé de maximiser ou de minimiser la fenêtre de l'Explorateur.

2
DPGT

Voici une réponse qui donne le comportement de Start au démarrage ou au basculement, sans la fenêtre d'invite de commande. L'inconvénient est qu'il peut être trompé par une fenêtre de l'Explorateur ayant un dossier du même nom ouvert ailleurs. Je pourrais résoudre ce problème en plongeant dans les fenêtres des enfants et en cherchant le chemin réel. Je dois trouver comment naviguer dans cette situation.

Utilisation (nécessite "Modèle d'objet hôte de script Windows" dans les références de votre projet):

Dim mShell As wshShell

mDocPath = whatever_path & "\" & lastfoldername
mExplorerPath = mShell.ExpandEnvironmentStrings("%SystemRoot%") & "\Explorer.exe"

If Not SwitchToFolder(lastfoldername) Then
    Shell PathName:=mExplorerPath & " """ & mDocPath & """", WindowStyle:=vbNormalFocus
End If

Module:

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function BringWindowToTop Lib "user32" _
(ByVal lngHWnd As Long) As Long

Function SwitchToFolder(pFolder As String) As Boolean

Dim hWnd As Long
Dim mRet As Long
Dim mText As String
Dim mWinClass As String
Dim mWinTitle As String

    SwitchToFolder = False

    hWnd = FindWindowEx(0, 0&, vbNullString, vbNullString)
    While hWnd <> 0 And SwitchToFolder = False
        mText = String(100, Chr(0))
        mRet = GetClassName(hWnd, mText, 100)
        mWinClass = Left(mText, mRet)
        If mWinClass = "CabinetWClass" Then
            mText = String(100, Chr(0))
            mRet = GetWindowText(hWnd, mText, 100)
            If mRet > 0 Then
                mWinTitle = Left(mText, mRet)
                If UCase(mWinTitle) = UCase(pFolder) Or _
                   UCase(Right(mWinTitle, Len(pFolder) + 1)) = "\" & UCase(pFolder) Then
                    BringWindowToTop hWnd
                    SwitchToFolder = True
                End If
            End If
        End If
        hWnd = FindWindowEx(0, hWnd, vbNullString, vbNullString)
    Wend

End Function
0
PhilHibbs

Je ne peux pas utiliser la commande Shell à cause de la sécurité de la société. C'est donc le meilleur moyen que j'ai trouvé sur Internet.

Sub OpenFileOrFolderOrWebsite() 
'Shows how to open files and / or folders and / or websites / or create    emails using the FollowHyperlink method
Dim strXLSFile As String, strPDFFile As String, strFolder As String, strWebsite As String 
Dim strEmail As String, strSubject As String, strEmailHyperlink As     String 

strFolder = "C:\Test Files\" 
strXLSFile = strFolder & "Test1.xls" 
strPDFFile = strFolder & "Test.pdf" 
strWebsite = "http://www.blalba.com/" 

strEmail = "mailto:[email protected]" 
strSubject = "?subject=Test" 
strEmailHyperlink = strEmail & strSubject 

 '**************FEEL FREE TO COMMENT ANY OF THESE TO TEST JUST ONE ITEM*********
 'Open Folder
ActiveWorkbook.FollowHyperlink Address:=strFolder, NewWindow:=True 
 'Open Excel workbook
ActiveWorkbook.FollowHyperlink Address:=strXLSFile, NewWindow:=True 
 'Open PDF file
ActiveWorkbook.FollowHyperlink Address:=strPDFFile, NewWindow:=True 
 'Open VBAX
ActiveWorkbook.FollowHyperlink Address:=strWebsite, NewWindow:=True 
 'Create New Email
ActiveWorkbook.FollowHyperlink Address:=strEmailHyperlink, NewWindow:=True 
 '******************************************************************************
End Sub

alors en fait son

strFolder = "C:\Test Files\"

et

ActiveWorkbook.FollowHyperlink Address:=strFolder, NewWindow:=True
0
Rafael

Private Sub Command0_Click ()

Application.FollowHyperlink "D:\1Zsnsn\SusuBarokah\20151008 Inventory.mdb"

End Sub

0
Atlas

Vous pouvez utiliser la commande Invite pour ouvrir l'Explorateur avec un chemin.

ici exemple avec batch ou command invite:

start "" Explorer.exe (path)

donc, dans VBA ms.access, vous pouvez écrire avec:

Dim Path
Path="C:\Example"
Shell "cmd /c start """" Explorer.exe " & Path ,vbHide
0
KhunRan

Je viens de l'utiliser et cela fonctionne bien:

System.Diagnostics.Process.Start ("C:/Utilisateurs/Admin/fichiers");

0
mojo

Merci à beaucoup de réponses ci-dessus et ailleurs, c'était ma solution à un problème similaire à l'OP. Le problème pour moi était de créer un bouton dans Word qui demande à l’utilisateur une adresse réseau et récupère les ressources du réseau local dans une fenêtre de l’explorateur.

Inaltéré, le code vous mènerait à \\10.1.1.1\Test, donc éditez comme bon vous semble. Je suis juste un singe sur un clavier, ici, donc tous les commentaires et suggestions sont les bienvenus.

Private Sub CommandButton1_Click()
    Dim ipAddress As Variant
    On Error GoTo ErrorHandler

    ipAddress = InputBox("Please enter the IP address of the network resource:", "Explore a network resource", "\\10.1.1.1")
    If ipAddress <> "" Then
        ThisDocument.FollowHyperlink ipAddress & "\Test"
    End If

    ExitPoint:
        Exit Sub

    ErrorHandler:
        If Err.Number = "4120" Then
            GoTo ExitPoint
        ElseIf Err.Number = "4198" Then
            MsgBox "Destination unavailable"
            GoTo ExitPoint
        End If

        MsgBox "Error " & Err.Number & vbCrLf & Err.Description
        Resume ExitPoint

End Sub
0
benJephunneh