次のコードを使用して、vbaからファイルの場所を開くことができます。
Dim Foldername As String
Foldername = "\\server\Instructions\"
Shell "C:\WINDOWS\Explorer.exe """ & Foldername & "", vbNormalFocus
このコードは、Windows共有とローカルドライブの両方に使用できます。
VbNormalFocusは、ビューを最大化する場合にVbMaximizedFocusのスワッパーにすることができます。
最も簡単な方法は
Application.FollowHyperlink [path]
これは1行だけです！
これに関連するいくつかのよりクールな知識を以下に示します。
レコード内のいくつかの条件に基づいてフォルダーを検索し、見つかったフォルダーを開く必要がある状況がありました。ソリューションを見つける作業を行っている間に、検索開始フォルダーを要求する小さなデータベースを作成して、4つの基準の場所を提供し、ユーザーが入力されたものと一致する4つ（またはそれ以上）のフォルダーを開く基準一致を実行できるようにします基準。
フォーム上のコード全体を次に示します。
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つのテキストボックスがあります。
担当者がいた場合、写真を投稿します...：/
このコードに追加したいことは他にもいくつかありますが、まだチャンスはありません。別のテーブルで機能したものを保存する方法、またはユーザーにそれらを保存に適したものとしてマークさせる方法が必要です。
私はすべてのコードの完全な信用を主張することはできません、私はスタックオーバーフローに関する他の投稿でさえ、私が周りで見つけたものからいくつかをまとめました。
リンクされた記事にあるように、後で参照するための答えを見つけやすくするため、ここに質問を投稿してから自分で答えるというアイデアが本当に好きです。
追加したい他の部分が終了したら、そのためのコードも投稿します。 :)
PhilHibbsのコメント（VBwhatnowの回答）のおかげで、私は最終的に、既存のウィンドウを再利用し、ユーザーにCMDウィンドウをフラッシュさせないソリューションを見つけることができました。
Dim path As String
path = CurrentProject.path & "\"
Shell "cmd /C start """" /max """ & path & """", vbHide
ここで、「パス」は開きたいフォルダです。
（この例では、現在のワークブックが保存されているフォルダーを開きます。）
長所：
- 新しいExplorerインスタンスを開かないようにします（ウィンドウが存在する場合にのみフォーカスを設定します）。
- Cmd-windowはnever vbHideのおかげで見える。
- 比較的単純です（win32ライブラリを参照する必要はありません）。
短所：
- ウィンドウの最大化（または最小化）は必須です。
説明：
最初はvbHideのみを使用してみました。これはうまく機能します...すでにそのようなフォルダが開かれていない限り、その場合既存のフォルダウィンドウは隠されて消えます！あなたは今幽霊を持っていますウィンドウがメモリ内で浮遊し、その後にフォルダを開こうとすると、非表示のウィンドウが再利用されます-効果はないようです。
言い換えると、「start」コマンドが既存のウィンドウを見つけると、指定されたvbAppWinStyleがCMDウィンドウと再利用されたExplorerウィンドウにbothに適用されます。 （幸いなことに、異なるvbAppWinStyle引数を指定して同じコマンドを再度呼び出すことで、これを使用してゴーストウィンドウを再表示できます。）
ただし、 'start'を呼び出すときに/ maxまたは/ minフラグを指定すると、CMDウィンドウで設定されたvbAppWinStyleが再帰的に適用されなくなります。 （またはオーバーライドしますか？技術的な詳細がわからないので、ここで一連のイベントが何であるかを正確に知りたいです。）
これが私がしたことです。
Dim strPath As String
strPath = "\\server\Instructions\"
Shell "cmd.exe /c start """" """ & strPath & """", vbNormalFocus
長所：
- 新しいExplorerインスタンスを開かないようにします（ウィンドウが存在する場合にのみフォーカスを設定します）。
- 比較的単純です（win32ライブラリを参照する必要はありません）。
- ウィンドウの最大化（または最小化）はnot必須です。ウィンドウは通常のサイズで開きます。
短所：
- Cmd-windowは短時間表示されます。
これにより、何も開いていない場合は常にフォルダーへのウィンドウが開き、そのフォルダーに対して開いているウィンドウがある場合は開いているウィンドウに切り替わります。
この基礎を作ってくれたPhilHibbsとAnorZakenに感謝します。 PhilHibbsのコメントはうまくいきませんでした。フォルダー名の前に二重引用符を2つ付けるには、コマンド文字列が必要でした。そして、Explorerウィンドウを最大化または最小化することを強制するのではなく、コマンドプロンプトウィンドウを少し表示することを好みました。
コマンドプロンプトウィンドウを使用せずに、開始の切り替えまたは起動の動作を提供する回答を次に示します。他の場所で開かれている同じ名前のフォルダーを持つエクスプローラーウィンドウにだまされる可能性があるという欠点があります。子ウィンドウに飛び込んで実際のパスを探すことでそれを修正するかもしれませんが、それをナビゲートする方法を見つけ出す必要があります。
使用法（プロジェクトの参照の「Windowsスクリプトホストオブジェクトモデル」が必要）：
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
モジュール：
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
会社のセキュリティのためにシェルコマンドを使用しないことがあります。インターネットで見つけた最良の方法です。
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
だから実際に
strFolder = "C:\Test Files\"
そして
ActiveWorkbook.FollowHyperlink Address:=strFolder, NewWindow:=True
Private Sub Command0_Click（）
Application.FollowHyperlink "D：\ 1Zsnsn\SusuBarokah\20151008 Inventory.mdb"
サブ終了
コマンドプロンプトを使用して、パスでエクスプローラーを開くことができます。
バッチまたはコマンドプロンプトを使用した例：
start "" Explorer.exe (path)
vBA ms.accessでは、次のように記述できます。
Dim Path
Path="C:\Example"
Shell "cmd /c start """" Explorer.exe " & Path ,vbHide
私はこれを使用しましたが、うまくいきます：
System.Diagnostics.Process.Start（ "C：/ Users/Admin/files"）;
上記および他の多くの回答のおかげで、これはOPと同様の問題に対する私の解決策でした。私にとっての問題は、ユーザーにネットワークアドレスを要求し、エクスプローラーウィンドウでLANリソースをプルアップするボタンをWordで作成することでした。
そのままで、コードは\\10.1.1.1\Test,必要に応じて編集します。私はここではキーボードの猿ですから、すべてのコメントや提案を歓迎します。
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