在 access 97 中查找完整路径的目录部分（减去文件名）

Question

由于各种原因，我被困在 Access 97 中，只需要获取完整路径名的路径部分。

例如名字

c:\whatever dir\another dir\stuff.mdb

应该变成

c:\whatever dir\another dir\

这个网站有一些关于如何做的建议： http://www.ammara.com/access_image_faq/parse_path_filename.html

但它们看起来相当可怕。一定有更好的办法吧？

Answer 1

你可以做一些简单的事情，比如：Left(path, InStrRev(path, "\"))

例子：

Function GetDirectory(path)
   GetDirectory = Left(path, InStrRev(path, Application.PathSeparator))
End Function

Answer 2

我总是使用FileSystemObject 来处理这类事情。这是我使用的一个小包装函数。请务必引用Microsoft Scripting Runtime。

Function StripFilename(sPathFile As String) As String

'given a full path and file, strip the filename off the end and return the path

Dim filesystem As New FileSystemObject

StripFilename = filesystem.GetParentFolderName(sPathFile) & "\"

Exit Function

End Function

Answer 3

这似乎有效。以上在 Excel 2010 中没有。

Function StripFilename(sPathFile As String) As String
'given a full path and file, strip the filename off the end and return the path
Dim filesystem As Object

Set filesystem = CreateObject("Scripting.FilesystemObject")

StripFilename = filesystem.GetParentFolderName(sPathFile) & "\"

Exit Function

End Function

Answer 4

如果您只需要当前在 Access UI 中打开的 MDB 的路径，我建议编写一个解析 CurrentDB.Name 的函数，然后将结果存储在函数内的静态变量中。像这样的：

Public Function CurrentPath() As String
  Dim strCurrentDBName As String
  Static strPath As String
  Dim i As Integer

  If Len(strPath) = 0 Then
     strCurrentDBName = CurrentDb.Name
     For i = Len(strCurrentDBName) To 1 Step -1
       If Mid(strCurrentDBName, i, 1) = "\" Then
          strPath = Left(strCurrentDBName, i)
          Exit For
       End If
    Next
  End If
  CurrentPath = strPath
End Function

这样做的好处是它只循环名称一次。

当然，它只适用于在用户界面中打开的文件。

另一种写法是使用上面函数内部link提供的函数，因此：

Public Function CurrentPath() As String
  Static strPath As String

  If Len(strPath) = 0 Then
     strPath = FolderFromPath(CurrentDB.Name)
  End If
  CurrentPath = strPath
End Function

这使得检索当前路径非常有效，同时利用可用于查找任何文件名/路径的路径的代码。

Answer 5

left(currentdb.Name,instr(1,currentdb.Name,dir(currentdb.Name))-1)

Dir 函数将仅返回完整路径的文件部分。此处使用 Currentdb.Name，但它可以是任何完整路径字符串。

Answer 6

vFilename="C:\Informes\Indicadores\Program\Ind_Cont_PRv.txt"

vDirFile = Replace(vFilename, Dir(vFileName, vbDirectory), "")

' 结果=C:\Informes\Indicadores_Contraloria\Programa\Versiones anteriores\

Answer 7

如果您对输入参数有信心，则可以使用这行代码，它使用本机拆分和连接函数以及 Excel 本机 Application.pathSeparator。

Split(Join(Split(strPath, "."), Application.pathSeparator), Application.pathSeparator)

如果您想要一个更更广泛的功能，下面的代码已经在 Windows 中测试过，并且应该也可以在 Mac 上运行（虽然没有经过测试）。请务必同时复制支持函数GetPathSeparator，或修改代码以使用Application.pathSeparator。请注意，这是初稿；我真的应该把它重构得更简洁。

Private Sub ParsePath2Test()
    'ParsePath2(DrivePathFileExt, -2) returns a multi-line string for debugging.
    Dim p As String, n As Integer

    Debug.Print String(2, vbCrLf)

    If True Then
        Debug.Print String(2, vbCrLf)
        Debug.Print ParsePath2("", -2)
        Debug.Print ParsePath2("C:", -2)
        Debug.Print ParsePath2("C:\", -2)
        Debug.Print ParsePath2("C:\Windows", -2)
        Debug.Print ParsePath2("C:\Windows\notepad.exe", -2)
        Debug.Print ParsePath2("C:\Windows\SysWOW64", -2)
        Debug.Print ParsePath2("C:\Windows\SysWOW64\", -2)
        Debug.Print ParsePath2("C:\Windows\SysWOW64\AcLayers.dll", -2)
        Debug.Print ParsePath2("C:\Windows\SysWOW64\.fakedir", -2)
        Debug.Print ParsePath2("C:\Windows\SysWOW64\fakefile.ext", -2)
    End If

    If True Then
        Debug.Print String(1, vbCrLf)
        Debug.Print ParsePath2("\Windows", -2)
        Debug.Print ParsePath2("\Windows\notepad.exe", -2)
        Debug.Print ParsePath2("\Windows\SysWOW64", -2)
        Debug.Print ParsePath2("\Windows\SysWOW64\", -2)
        Debug.Print ParsePath2("\Windows\SysWOW64\AcLayers.dll", -2)
        Debug.Print ParsePath2("\Windows\SysWOW64\.fakedir", -2)
        Debug.Print ParsePath2("\Windows\SysWOW64\fakefile.ext", -2)
    End If

    If True Then
        Debug.Print String(1, vbCrLf)
        Debug.Print ParsePath2("Windows\notepad.exe", -2)
        Debug.Print ParsePath2("Windows\SysWOW64", -2)
        Debug.Print ParsePath2("Windows\SysWOW64\", -2)
        Debug.Print ParsePath2("Windows\SysWOW64\AcLayers.dll", -2)
        Debug.Print ParsePath2("Windows\SysWOW64\.fakedir", -2)
        Debug.Print ParsePath2("Windows\SysWOW64\fakefile.ext", -2)
        Debug.Print ParsePath2(".fakedir", -2)
        Debug.Print ParsePath2("fakefile.txt", -2)
        Debug.Print ParsePath2("fakefile.onenote", -2)
        Debug.Print ParsePath2("C:\Personal\Workspace\Code\PythonVenvs\xlwings_test\.idea", -2)
        Debug.Print ParsePath2("Windows", -2)   ' Expected to raise error 52
    End If

    If True Then
        Debug.Print String(2, vbCrLf)
        Debug.Print "ParsePath2 ""\Windows\SysWOW64\fakefile.ext"" with different ReturnType values"
        Debug.Print , "{empty}", "D", ParsePath2("Windows\SysWOW64\fakefile.ext")(1)
        Debug.Print , "0", "D", ParsePath2("Windows\SysWOW64\fakefile.ext", 0)(1)
        Debug.Print , "1", "ext", ParsePath2("Windows\SysWOW64\fakefile.ext", 1)
        Debug.Print , "10", "file", ParsePath2("Windows\SysWOW64\fakefile.ext", 10)
        Debug.Print , "11", "file.ext", ParsePath2("Windows\SysWOW64\fakefile.ext", 11)
        Debug.Print , "100", "path", ParsePath2("Windows\SysWOW64\fakefile.ext", 100)
        Debug.Print , "110", "path\file", ParsePath2("Windows\SysWOW64\fakefile.ext", 110)
        Debug.Print , "111", "path\file.ext", ParsePath2("Windows\SysWOW64\fakefile.ext", 111)
        Debug.Print , "1000", "D", ParsePath2("Windows\SysWOW64\fakefile.ext", 1000)
        Debug.Print , "1100", "D:\path", ParsePath2("Windows\SysWOW64\fakefile.ext", 1100)
        Debug.Print , "1110", "D:\p\file", ParsePath2("Windows\SysWOW64\fakefile.ext", 1110)
        Debug.Print , "1111", "D:\p\f.ext", ParsePath2("Windows\SysWOW64\fakefile.ext", 1111)
        On Error GoTo EH:
        ' This is expected to presetn an error:
        p = "Windows\SysWOW64\fakefile.ext"
        n = 1010
        Debug.Print "1010", "D:\p\file.ext", ParsePath2("Windows\SysWOW64\fakefile.ext", 1010)
        On Error GoTo 0
    End If
Exit Sub
EH:
    Debug.Print , CStr(n), "Error: "; Err.Number, Err.Description
    Resume Next
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function ParsePath2(ByVal DrivePathFileExt As String _
                         , Optional ReturnType As Integer = 0)
' Writen by Chris Advena.  You may modify and use this code provided you leave
' this credit in the code.
' Parses the input DrivePathFileExt string into individual components (drive
' letter, folders, filename and extension) and returns the portions you wish
' based on ReturnType.
' Returns either an array of strings (ReturnType = 0) or an individual string
' (all other defined ReturnType values).
'
' Parameters:
'   DrivePathFileExt: The full drive letter, path, filename and extension
'   ReturnType: -2 or a string up of to 4 ones with leading or lagging zeros
'              (e.g., 0001)
'      -2: special code for debugging use in ParsePath2Test().
'          Results in printing verbose information to the Immediate window.
'       0: default: Array(driveStr, pathStr, fileStr, extStr)
'       1: extension
'      10: filename stripped of extension
'      11: filename.extension, excluding drive and folders
'     100: folders, excluding drive letter filename and extension
'     111: folders\filename.extension, excluding drive letter
'    1000: drive leter only
'    1100: drive:\folders,  excluding filename and extension
'    1110: drive:\folders\filename, excluding extension
'    1010, 0101, 1001: invalid ReturnTypes.  Will result raise error 380, Value
'          is not valid.

    Dim driveStr As String, pathStr As String
    Dim fileStr As String, extStr As String
    Dim drivePathStr As String
    Dim pathFileExtStr As String, fileExtStr As String
    Dim s As String, cnt As Integer
    Dim i As Integer, slashStr As String
    Dim dotLoc As Integer, slashLoc As Integer, colonLoc As Integer
    Dim extLen As Integer, fileLen As Integer, pathLen As Integer
    Dim errStr As String

    DrivePathFileExt = Trim(DrivePathFileExt)

    If DrivePathFileExt = "" Then
        fileStr = ""
        extStr = ""
        fileExtStr = ""
        pathStr = ""
        pathFileExtStr = ""
        drivePathStr = ""
        GoTo ReturnResults
    End If

    ' Determine if Dos(/) or UNIX(\) slash is used
    slashStr = GetPathSeparator(DrivePathFileExt)

' Find location of colon, rightmost slash and dot.
    ' COLON: colonLoc and driveStr
    colonLoc = 0
    driveStr = ""
    If Mid(DrivePathFileExt, 2, 1) = ":" Then
        colonLoc = 2
        driveStr = Left(DrivePathFileExt, 1)
    End If
    #If Mac Then
        pathFileExtStr = DrivePathFileExt
    #Else ' Windows
        pathFileExtStr = ""
        If Len(DrivePathFileExt) > colonLoc _
        Then pathFileExtStr = Mid(DrivePathFileExt, colonLoc + 1)
    #End If

    ' SLASH: slashLoc, fileExtStr and fileStr
    ' Find the rightmost path separator (Win backslash or Mac Fwdslash).
    slashLoc = InStrRev(DrivePathFileExt, slashStr, -1, vbBinaryCompare)

    ' DOT: dotLoc and extStr
    ' Find rightmost dot.  If that dot is not part of a relative reference,
    ' then set dotLoc.  dotLoc is meant to apply to the dot before an extension,
    ' NOT relative path reference dots.  REl ref dots appear as "." or ".." at
    ' the very leftmost of the path string.
    dotLoc = InStrRev(DrivePathFileExt, ".", -1, vbTextCompare)
    If Left(DrivePathFileExt, 1) = "." And dotLoc <= 2 Then dotLoc = 0
    If slashLoc + 1 = dotLoc Then
        dotLoc = 0
        If Len(extStr) = 0 And Right(pathFileExtStr, 1) <> slashStr _
        Then pathFileExtStr = pathFileExtStr & slashStr
    End If
    #If Not Mac Then
        ' In windows, filenames cannot end with a dot (".").
        If dotLoc = Len(DrivePathFileExt) Then
            s = "Error in FileManagementMod.ParsePath2 function.  " _
                & "DrivePathFileExt " & DrivePathFileExt _
                & " cannot end iwth a dot ('.')."
            Err.Raise 52, "FileManagementMod.ParsePath2", s
        End If
    #End If

    ' extStr
    extStr = ""
    If dotLoc > 0 And (dotLoc < Len(DrivePathFileExt)) _
    Then extStr = Mid(DrivePathFileExt, dotLoc + 1)

    ' fileExtStr
    fileExtStr = ""
    If slashLoc > 0 _
    And slashLoc < Len(DrivePathFileExt) _
    And dotLoc > slashLoc Then
        fileExtStr = Mid(DrivePathFileExt, slashLoc + 1)
    End If


' Validate the input: DrivePathFileExt
    s = ""
    #If Mac Then
        If InStr(1, DrivePathFileExt, ":") > 0 Then
            s = "DrivePathFileExt ('" & DrivePathFileExt _
                & "')has invalid format.  " _
                & "UNIX/Mac filenames cannot contain a colon ('.')."
        End If
    #End If
    If Not colonLoc = 0 And slashLoc = 0 And dotLoc = 0 _
    And Left(DrivePathFileExt, 1) <> slashStr _
    And Left(DrivePathFileExt, 1) <> "." Then
        s = "DrivePathFileExt ('" & DrivePathFileExt _
            & "') has invalid format.  " _
            & "Good example: 'C:\folder\file.txt'"
    ElseIf colonLoc <> 0 And colonLoc <> 2 Then
        ' We are on Windows and there is a colon; it can only be
        ' in position 2.
        s = "DrivePathFileExt ('" & DrivePathFileExt _
            & "') has invalid format.  " _
            & "In the  Windows operating system, " _
            & "a colon (':') can only be the second character '" _
            & "of a valid file path. "
    ElseIf Left(DrivePathFileExt, 1) = ":" _
    Or InStr(3, DrivePathFileExt, ":", vbTextCompare) > 0 Then
        'If path contains a drive letter, it must contain at least one slash.
        s = "DrivePathFileExt ('" & DrivePathFileExt _
            & "') has invalid format.  " _
            & "Colon can only appear in the second character position." _
            & slashStr & "')."
    ElseIf colonLoc > 0 And slashLoc = 0 _
    And Len(DrivePathFileExt) > 2 Then
        'If path contains a drive letter, it must contain at least one slash.
        s = "DrivePathFileExt ('" & DrivePathFileExt _
            & "') has invalid format.  " _
            & "The last dot ('.') cannot be before the last file separator '" _
            & slashStr & "')."
    ElseIf colonLoc = 2 _
    And InStr(1, DrivePathFileExt, slashStr, vbTextCompare) = 0 _
    And Len(DrivePathFileExt) > 2 Then
        ' There is a colon, but no file separator (slash).  This is invalid.
        s = "DrivePathFileExt ('" & DrivePathFileExt _
            & "') has invalid format.  " _
            & "If a drive letter is included, then there must be at " _
            & "least one file separator character ('" & slashStr & "')."
    ElseIf Len(driveStr) > 0 And Len(DrivePathFileExt) > 2 And slashLoc = 0 Then
        ' If path contains a drive letter and is more than 2 character long
        ' (e.g., 'C:'), it must contain at least one slash.
        s = "DrivePathFileExt cannot contain a drive letter but no path separator."
    End If
    If Len(s) > 0 Then
    End If



' Determine if DrivePathFileExt = DrivePath
' or  = Path (with no fileStr or extStr components).
    If Right(DrivePathFileExt, 1) = slashStr _
    Or slashLoc = 0 _
    Or dotLoc = 0 _
    Or (dotLoc > 0 And dotLoc <= slashLoc + 1) Then
        ' If rightmost character is the slashStr, then no fileExt exists, just drivePath
        ' If no dot found, then no extension.  Assume a folder is after the last slashstr,
        ' not a filename.
        ' If a dot is found (extension exists),
        ' If a rightmost dot appears one-char to the right of the rightmost slash
        '    or anywhere before (left) of that, it is not a file/ext separator. Exmaple:
        '    'C:\folder1\.folder2' Then
        ' If no slashes, then no fileExt exists.  It must just be a driveletter.
        ' DrivePathFileExt contains no file or ext name.
        fileStr = ""
        extStr = ""
        fileExtStr = ""
        pathStr = pathFileExtStr
        drivePathStr = DrivePathFileExt
        GoTo ReturnResults
    Else
        ' fileStr
        fileStr = ""
        If slashLoc > 0 Then
            If Len(extStr) = 0 Then
                fileStr = fileExtStr
            Else
                ' length of filename excluding dot and extension.
                i = Len(fileExtStr) - Len(extStr) - 1
                fileStr = Left(fileExtStr, i)
            End If
        Else
                s = "Error in FileManagementMod.ParsePath2 function. " _
                    & "*** Unhandled scenario: find fileStr when slashLoc = 0. *** "
                Err.Raise 52, "FileManagementMod.ParsePath2", s
        End If

        ' pathStr
        pathStr = ""
        ' length of pathFileExtStr excluding fileExt.
        i = Len(pathFileExtStr) - Len(fileExtStr)
        pathStr = Left(pathFileExtStr, i)

        ' drivePathStr
        drivePathStr = ""
        ' length of DrivePathFileExt excluding dot and extension.
        i = Len(DrivePathFileExt) - Len(fileExtStr)
        drivePathStr = Left(DrivePathFileExt, i)
    End If

ReturnResults:
    ' ReturnType uses a 4-digit binary code: dpfe = drive path file extension,
    ' where 1 = return in array and 0 = do not return in array
    ' -2, and 0 are special cases that do not follow the code.

    ' Note: pathstr is determined with the tailing slashstr
    If Len(drivePathStr) > 0 And Right(drivePathStr, 1) <> slashStr _
    Then drivePathStr = drivePathStr & slashStr
    If Len(pathStr) > 0 And Right(pathStr, 1) <> slashStr _
    Then pathStr = pathStr & slashStr
    #If Not Mac Then
        ' Including this code add a slash to the beginnning where missing.
        ' the downside is that it would create an absolute path where a
        ' sub-path of the current folder is intended.
        'If colonLoc = 0 Then
        '    If Len(drivePathStr) > 0 And Not IsIn(Left(drivePathStr, 1), slashStr, ".") _
             Then drivePathStr = slashStr & drivePathStr
        '    If Len(pathStr) > 0 And Not IsIn(Left(pathStr, 1), slashStr, ".") _
             Then pathStr = slashStr & pathStr
        '    If Len(pathFileExtStr) > 0 And Not IsIn(Left(pathFileExtStr, 1), slashStr, ".") _
             Then pathFileExtStr = slashStr & pathFileExtStr
        'End If
    #End If
    Select Case ReturnType
        Case -2  ' used for ParsePath2Test() only.
            ParsePath2 = "DrivePathFileExt          " _
                        & CStr(Nz(DrivePathFileExt, "{empty string}")) _
                        & vbCrLf & "        " _
                        & "--------------    -----------------------------------------" _
                        & vbCrLf & "        " & "D:\Path\          " & drivePathStr _
                        & vbCrLf & "        " & "\path[\file.ext]  " & pathFileExtStr _
                        & vbCrLf & "        " & "\path\            " & pathStr _
                        & vbCrLf & "        " & "file.ext          " & fileExtStr _
                        & vbCrLf & "        " & "file              " & fileStr _
                        & vbCrLf & "        " & "ext               " & extStr _
                        & vbCrLf & "        " & "D                 " & driveStr _
                        & vbCrLf & vbCrLf
            ' My custom debug printer prints to Immediate winodw and log file.
            ' Dbg.Prnt 2, ParsePath2
            Debug.Print ParsePath2
        Case 1      '0001: ext
            ParsePath2 = extStr
        Case 10     '0010: file
            ParsePath2 = fileStr
        Case 11     '0011: file.ext
            ParsePath2 = fileExtStr
        Case 100    '0100: path
            ParsePath2 = pathStr
        Case 110    '0110: (path, file)
            ParsePath2 = pathStr & fileStr
        Case 111    '0111:
            ParsePath2 = pathFileExtStr
        Case 1000
            ParsePath2 = driveStr
        Case 1100
            ParsePath2 = drivePathStr
        Case 1110
            ParsePath2 = drivePathStr & fileStr
        Case 1111
            ParsePath2 = DrivePathFileExt
        Case 1010, 101, 1001
            s = "Error in FileManagementMod.ParsePath2 function.  " _
                & "Value of Paramter (ReturnType = " _
                & CStr(ReturnType) & ") is not valid."
            Err.Raise 380, "FileManagementMod.ParsePath2", s
        Case Else   '   default: 0
            ParsePath2 = Array(driveStr, pathStr, fileStr, extStr)
    End Select

End Function

支持函数 GetPathSeparatorTest 扩展本机 Application.pathSeparator（或在需要时绕过）以在 Mac 和 Win 上工作。它还可以采用可选的路径字符串，并尝试确定字符串中使用的路径分隔符（有利于 OS 本机路径分隔符）。

Private Sub GetPathSeparatorTest()
    Dim s As String
    Debug.Print "GetPathSeparator(s):"
    Debug.Print "s not provided: ", GetPathSeparator
    s = "C:\folder1\folder2\file.ext"
    Debug.Print "s = "; s, GetPathSeparator(DrivePathFileExt:=s)
    s = "C:/folder1/folder2/file.ext"
    Debug.Print "s = "; s, GetPathSeparator(DrivePathFileExt:=s)
End Sub
Function GetPathSeparator(Optional DrivePathFileExt As String = "") As String
' by Chris Advena
' Finds the path separator from a string, DrivePathFileExt.
' If DrivePathFileExt is not provided, return the operating system path separator
' (Windows = backslash, Mac = forwardslash).
' Mac/Win compatible.

    ' Initialize
    Dim retStr As String: retStr = ""
    Dim OSSlash As String: OSSlash = ""
    Dim OSOppositeSlash As String: OSOppositeSlash = ""
        Dim PathFileExtSlash As String

    GetPathSeparator = ""
    retStr = ""

    ' Determine if OS expects fwd or back slash ("/" or "\").
    On Error GoTo EH
    OSSlash = Application.pathSeparator

    If DrivePathFileExt = "" Then
    ' Input parameter DrivePathFileExt is empty, so use OS file separator.
        retStr = OSSlash
    Else
    ' Input parameter DrivePathFileExt provided.  See if it contains / or \.
        ' Set OSOppositeSlash to the opposite slash the OS expects.
        OSOppositeSlash = "\"
        If OSSlash = "\" Then OSOppositeSlash = "/"

        ' If DrivePathFileExt does NOT contain OSSlash
        ' and DOES contain OSOppositeSlash, return OSOppositeSlash.
        ' Otherwise, assume OSSlash is correct.
        retStr = OSSlash
        If InStr(1, DrivePathFileExt, OSSlash, vbTextCompare) = 0 _
        And InStr(1, DrivePathFileExt, OSOppositeSlash, vbTextCompare) > 0 Then
            retStr = OSOppositeSlash
        End If
    End If

    GetPathSeparator = retStr
Exit Function
EH:
    ' Application.PathSeparator property does not exist in Access,
    ' so get it the slightly less easy way.
    #If Mac Then ' Application.PathSeparator doesn't seem to exist in Access...
        OSSlash = "/"
    #Else
        OSSlash = "\"
    #End If
    Resume Next
End Function

支持功能（实际注释掉了，不打算用的可以跳过）。

Sub IsInTest()
' IsIn2 is case insensitive
    Dim StrToFind As String, arr As Variant
    arr = Array("Me", "You", "Dog", "Boo")

    StrToFind = "doG"
    Debug.Print "Is '" & CStr(StrToFind) & "' in list (expect True): " _
                , IsIn(StrToFind, "Me", "You", "Dog", "Boo")

    StrToFind = "Porcupine"
    Debug.Print "Is '" & CStr(StrToFind) & "' in list (expect False): " _
                , IsIn(StrToFind, "Me", "You", "Dog", "Boo")
End Sub
Function IsIn(ByVal StrToFind, ParamArray StringArgs() As Variant) As Boolean
' StrToFind: the string to find in the list of StringArgs()
' StringArgs: 1-dimensional array containing string values.
' Built for Strings, but actually works with other data types.
    Dim arr As Variant
    arr = StringArgs
    IsIn = Not IsError(Application.Match(StrToFind, arr, False))
End Function

Answer 8

试试这个功能：

Function FolderPath(FilePath As String) As String

    '---------------------------------------------------- -
    '从文件路径返回文件夹路径。

    '作者：克里斯托斯·萨马拉斯
    '日期：2013 年 6 月 11 日
    '---------------------------------------------------- -

    将文件名变暗为字符串

    带工作表功能
        FileName = Mid(FilePath, .Find("*", .Substitute(FilePath, "\", "*", Len(FilePath) - _
                    Len(.Substitute(FilePath, "\", "")))) + 1, Len(FilePath))
    结束于

    FolderPath = Left(FilePath, Len(FilePath) - Len(FileName) - 1)

结束函数

如果您不想删除文件夹路径末尾的最后一个反斜杠“\”，请将最后一行更改为：

FolderPath = Left(FilePath, Len(FilePath) - Len(FileName))

例子：

FolderPath("C:\Users\Christos\Desktop\LAT Analysers Signal Correction\1\TP 14_03_2013_5.csv")

给出：

C:\Users\Christos\Desktop\LAT Analyzers Signal Correction\1

或

C:\Users\Christos\Desktop\LAT Analyzers Signal Correction\1\

在第二种情况下（注意末尾有一个反斜杠）。

希望对你有帮助……

Answer 9

使用这些代码并享受它。

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