如何在Excel VBA中存储文件夹path

Sub GetFolderPath() Dim InputFolder As String Dim OutputFolder As String InputFolder = Application.GetOpenFilename("Folder, *") Range("C1").Select ActiveCell.Value = InputFolder & "\" End Sub 

我正在使用上面的代码来尝试存储,然后粘贴另一个macros我正在运行的文件夹位置。

任何想法如何使其停止在文件夹级别或从最后删除文件名?

谢谢!

你可以使用

 FileName = Dir(InputFolder) InputFolder = Left(InputFolder, Len(InputFolder)-Len(FileName)) 

Dir()只获取文件名,而Left()有助于将string修剪到文件夹path。

有更短的select来获得你的path。 只有一行:

 '...your code Dim InputFolder As String InputFolder = Application.GetOpenFilename("Folder, *") 'new, single line solution InputFolder = Mid(InputFolder, 1, InStrRev(InputFolder, Application.PathSeparator)) 

我认为可以有更多的select可用:)

如果我理解正确,你想得到一个文件的path,但是你不想在InputFolderstring中input文件名。 如果我理解正确,那么这将做的伎俩:

  Option Explicit Sub GetFolderPath() Dim InputFolder As String Dim OutputFolder As String InputFolder = Application.GetOpenFilename("Folder, *") Range("C1").Value = getFilePath(InputFolder) End Sub Function getFilePath(path As String) Dim filePath() As String Dim finalString As String Dim x As Integer filePath = Split(path, "\") For x = 0 To UBound(filePath) - 1 finalString = finalString & filePath(x) & "\" Next getFilePath = finalString End Function 

此外,您不必将文件名写入电子表格,以便其他macros获取它。 您可以从第一个macros中调用另一个macros,并将该文件名作为parameter passing,或将文件名variables设置为模块级variables,以便其他macros可以访问该macros,假定第二个macros在同一个模块中。

哇,这个板子真不可思议! 我会使用casey的代码,它完美的工作:)。 我还添加了一个函数来根据需要创build子文件夹。

这是我最终决定的产品。

  Option Explicit Sub GetFolderPath() Dim InputFolder As String Dim OutputFolder As String MsgBox ("Please Select the Folder of Origin") InputFolder = Application.GetOpenFilename("Folder, *") Range("D5").Value = getFilePath(InputFolder) MsgBox ("Please Select the Desired Destination Root Folder") InputFolder = Application.GetOpenFilename("Folder, *") Range("E5").Value = getFilePath(InputFolder) Dim OutputSubFolder As String Dim Cell As Range Range("E5").Select OutputSubFolder = ActiveCell.Value 'Loop through this range which includes the needed subfolders Range("C5:C100000").Select For Each Cell In Selection On Error Resume Next MkDir OutputSubFolder & Cell On Error GoTo 0 Next Cell End Sub Function getFilePath(path As String) Dim filePath() As String Dim finalString As String Dim x As Integer filePath = Split(path, "\") For x = 0 To UBound(filePath) - 1 finalString = finalString & filePath(x) & "\" Next getFilePath = finalString End Function