Find the directory part (minus the filename) of a full path in access 97

半腔热情 提交于 2019-11-29 09:06:31

That's about it. There is no magic built-in function...

You can do something simple like: Left(path, InStrRev(path, "\"))

Example:

Function GetDirectory(path)
   GetDirectory = Left(path, InStrRev(path, "\"))
End Function
John Mo

I always used the FileSystemObject for this sort of thing. Here's a little wrapper function I used. Be sure to reference the 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
Jeff Stander

This seems to work. The above doesn't in 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

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

The Dir function will return only the file portion of the full path. Currentdb.Name is used here, but it could be any full path string.

David-W-Fenton

If you're just needing the path of the MDB currently open in the Access UI, I'd suggest writing a function that parses CurrentDB.Name and then stores the result in a Static variable inside the function. Something like this:

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

This has the advantage that it only loops through the name one time.

Of course, it only works with the file that's open in the user interface.

Another way to write this would be to use the functions provided at the link inside the function above, thus:

Public Function CurrentPath() As String
  Static strPath As String

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

This makes retrieving the current path very efficient while utilizing code that can be used for finding the path for any filename/path.

Try this function:

Function FolderPath(FilePath As String) As String

    '--------------------------------------------------
    'Returns the folder path form the file path.

    'Written by:    Christos Samaras
    'Date:          06/11/2013
    '--------------------------------------------------

    Dim FileName As String

    With WorksheetFunction
        FileName = Mid(FilePath, .Find("*", .Substitute(FilePath, "\", "*", Len(FilePath) - _
                    Len(.Substitute(FilePath, "\", "")))) + 1, Len(FilePath))
    End With

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

End Function

If you don't want to remove the last backslash "\" at the end of the folder's path, change the last line with this:

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

Example:

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

gives:

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

or

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

in the second case (note that there is a backslash at the end).

I hope it helps...

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

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

' Result=C:\Informes\Indicadores_Contraloria\Programa\Versiones anteriores\

Use these codes and enjoy it.

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

And here you can call function:

Sub test()
Dim s
For Each s In GetDirectoryName("C:\New folder")
Debug.Print s
Next
End Sub
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!