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

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

End Sub

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

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

谢谢!

4

4 回答 4

2

你可以使用

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

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

于 2013-05-30T19:08:32.280 回答
1

还有更短的选择来获取您的路径。只需一行:

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

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

而且我认为可能有更多可用的选择:)

于 2013-05-30T19:36:01.917 回答
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
于 2013-06-03T19:01:04.223 回答
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

Also, you do not have to write the file name to the spreadsheet in order for another macro to get it. You can just call the other macro from your first macro and pass the file name as a parameter or set the file name variable as a module level variable so it can be accessed by the other macro, assuming that second macro is in the same module.

于 2013-05-30T19:10:25.490 回答