如何在Excel VBA中存储文件夹路径

时间:2013-05-30 18:54:42

标签: excel vba

Sub GetFolderPath()
Dim InputFolder As String
Dim OutputFolder As String

InputFolder = Application.GetOpenFilename("Folder, *")
Range("C1").Select
ActiveCell.Value = InputFolder & "\"

End Sub

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

知道如何让它在文件夹级别停止或从结尾删除文件名吗?

谢谢!

4 个答案:

答案 0 :(得分:2)

您可以使用

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

Dir()只获取文件名,Left()帮助将字符串修剪为文件夹路径。

答案 1 :(得分:1)

有更短的选择来获得你的道路。只需一行:

'...your code
Dim InputFolder As String
InputFolder = Application.GetOpenFilename("Folder, *")

'new, single line solution
InputFolder = Mid(InputFolder, 1, InStrRev(InputFolder, Application.PathSeparator))

我认为可以有更多选择:)

答案 2 :(得分:0)

如果我理解正确,您希望获取文件的路径,但不想在InputFolder字符串中输入文件名。如果我理解正确,那么这将解决问题:

    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

此外,您不必将文件名写入电子表格,以便其他宏获取它。您可以从第一个宏调用另一个宏并将文件名作为参数传递,或者将文件名变量设置为模块级变量,以便其他宏可以访问它,假设第二个宏位于同一个模块中。

答案 3 :(得分:0)

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

这是我确定的最终产品。

    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