47

Windows エクスプローラーでフォルダーを開くアクセス フォームのボタンをクリックしたいと考えています。

VBAでこれを行う方法はありますか？

4

11 に答える 11

59

次のコードを使用して、vba からファイルの場所を開くことができます。

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

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

このコードは、Windows 共有とローカル ドライブの両方に使用できます。

最大化されたビューが必要な場合は、VbNormalFocus を VbMaximizedFocus のスワッパーにすることができます。

于 2012-06-26T10:49:05.317 に答える
11

PhilHibbs のコメント (VBwhatnow の回答) のおかげで、既存のウィンドウを再利用し、ユーザーで CMD ウィンドウのフラッシュを回避するソリューションを最終的に見つけることができました。

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

ここで、「パス」は開きたいフォルダーです。

(この例では、現在のブックが保存されているフォルダーを開きます。)

長所：

  • 新しいエクスプローラー インスタンスを開かないようにします (ウィンドウが存在する場合にのみフォーカスを設定します)。
  • vbHide のおかげで、cmd-window は表示されません。
  • 比較的単純です (win32 ライブラリを参照する必要はありません)。

短所：

  • ウィンドウの最大化 (または最小化) は必須です。

説明：

最初はvbHideだけでやってみました。これはうまく機能します...そのようなフォルダーが既に開かれている場合を除き、その場合、既存のフォルダーウィンドウは非表示になり、消えます! ゴーストウィンドウがメモリ内に浮かんでおり、その後フォルダーを開こうとすると、非表示のウィンドウが再利用されます-一見効果がありません。

つまり、「開始」コマンドが既存のウィンドウを検出すると、指定された vbAppWinStyle がCMD ウィンドウと再利用されたエクスプローラ ウィンドウの両方に適用されます。(幸いなことに、別の vbAppWinStyle 引数を指定して同じコマンドを再度呼び出すことで、これを使用してゴースト ウィンドウを非表示に戻すことができます。)

ただし、'start' を呼び出すときに /max または /min フラグを指定すると、CMD ウィンドウに設定された vbAppWinStyle が再帰的に適用されなくなります。(またはそれをオーバーライドしますか? 技術的な詳細が何であるかはわかりません。ここで一連のイベントが何であるかを正確に知りたいと思っています。)

于 2015-09-02T17:05:01.857 に答える
7

これに関連するさらにクールな知識を次に示します。

レコード内の少しの基準に基づいてフォルダーを検索し、見つかったフォルダーを開く必要がある状況がありました。解決策を見つける作業をしているときに、検索開始フォルダーを要求する小さなデータベースを作成しました基準。

フォームのコード全体は次のとおりです。

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

フォームにはテーブルに基づくサブフォームがあり、フォームには基準用の 4 つのテキスト ボックス、クリック手順につながる 2 つのボタン、および開始フォルダーの文字列を格納するための 1 つのテキスト ボックスがあります。リストされたフォルダーの数と、条件を検索するときに処理された数を表示するために使用される 2 つのテキスト ボックスがあります。

担当者がいたら、写真を投稿します... :/

このコードに追加したいことがいくつかありますが、まだ機会がありません。機能したものを別のテーブルに保存するか、ユーザーに保存してもよいとマークしてもらう方法が必要です。

すべてのコードの完全な功績を主張することはできません。スタックオーバーフローの他の投稿であっても、あちこちで見つけたものからいくつかをまとめました。

リンクされた記事にあるように、後で参照するために回答を簡単に見つけることができるため、ここに質問を投稿してから自分で回答するというアイデアが本当に気に入っています.

追加したい他の部分が完成したら、そのコードも投稿します。:)

于 2013-05-28T07:19:35.010 に答える