Public Function GetDirectoryName(ByVal source As String) As String()
Dim fso, oFolder, oSubfolder, oFile, queue As Collection
Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
Dim source_file() As String
Dim i As Integer
queue.Add fso.GetFolder(source) 'obviously replace
Do While queue.Count > 0
Set oFolder = queue(1)
queue.Remove 1 'dequeue
'...insert any folder processing code here...
For Each oSubfolder In oFolder.SubFolders
queue.Add oSubfolder 'enqueue
Next oSubfolder
For Each oFile In oFolder.Files
'...insert any file processing code here...
'Debug.Print oFile
i = i + 1
ReDim Preserve source_file(i)
source_file(i) = oFile
Next oFile
Loop
GetDirectoryName = source_file
End Function
这里你可以调用函数:
Sub test()
Dim s
For Each s In GetDirectoryName("C:\New folder")
Debug.Print s
Next
End Sub
Dim ParentPath As String: ParentPath = "\"
Dim ThisWorkbookPath As String
Dim ThisWorkbookPathParts, Part As Variant
Dim Count, Parts As Long
ThisWorkbookPath = ThisWorkbook.Path
ThisWorkbookPathParts = Split(ThisWorkbookPath, _
Application.PathSeparator)
Parts = UBound(ThisWorkbookPathParts)
Count = 0
For Each Part In ThisWorkbookPathParts
If Count > 0 Then
ParentPath = ParentPath & Part & "\"
End If
Count = Count + 1
If Count = Parts Then Exit For
Next
MsgBox "File-Drive = " & ThisWorkbookPathParts _
(LBound(ThisWorkbookPathParts))
MsgBox "Parent-Path = " & ParentPath
但如果没有,这就足够了。
解决方案 B:
Dim ThisWorkbookPath As String
ThisWorkbookPath = ThisWorkbook.Path
MsgBox "Working-Directory = " & ThisWorkbookPath
Sub openPath()
Dim path As String
path = Application.ActivePresentation.path
Shell Environ("windir") & "\explorer.exe """ & path & "", vbNormalFocus
End Sub