如何使用 vba 获取当前的工作目录?

我正在使用微软 Excel 2010,并尝试使用以下代码获取工作目录,

    path = ActiveWorkbook.Path

但 ActiveWorkbook.Path 返回空白。

347280 次浏览

ActiveWorkbook 似乎没有被保存... ..。

试试 CurDir()

根据您所寻找的内容,您有多种选择。 Workbook.Path返回保存的工作簿的路径。Application.Path返回 Excel 可执行文件的路径。CurDir返回当前的工作路径,这可能默认为您的“我的文档”文件夹或类似的文件夹。

还可以使用 Windows 脚本 shell 对象的.CurrentDirectory 属性。

Set wshell = CreateObject("WScript.Shell")
Debug.Print wshell.CurrentDirectory

但结果应该和正义一样

Debug.Print CurDir

我测试过了:

当我打开一个 Excel 文档 D:\db\tmp\test1.xlsm:

  • 返回 C:\Users\[username]\Documents

  • 返回 D:\db\tmp

因此 CurDir()有一个系统默认值,可以更改。

对于同一保存的工作簿,ActiveWorkbook.Path不变。

例如,在执行“ File/Save As”命令时,CurDir()会发生变化,并在 File/Directory 选择对话框中选择一个随机目录。然后单击“取消”跳过保存。但是 CurDir()已经更改为最后选定的目录。

用这些密码好好享受吧。

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

仅对路径本身使用 Application.ActiveWorkbook.Path(不带工作簿名称) ,对具有工作簿名称的路径使用 Application.ActiveWorkbook.FullName

你的密码是 path = ActiveWorkbook.Path

返回空白,因为您还没有保存工作簿。

要解决这个问题,请返回到 Excel 工作表,保存工作表,然后再次运行代码。

这次它不会显示空白,但会显示它所在的路径(当前文件夹)

希望这有帮助。

这是我在 探险家窗口中对 打开当前路径使用的 VBA:

Shell Environ("windir") & "\explorer.exe """ & CurDir() & "",vbNormalFocus

微软文档 :

如果你真的是指纯工作目录的话这个应该很适合你。

解决方案 A:

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