Проблема GetAbsolutePathName о получении неверного пути к каталогу (Excel VBA)

Question

Я ожидаю получить каталог полного пути, но я получил короткий путь от функции GetAbsolutePathName. Как я могу получить полный путь к каталогу?

Это MS Excel Pro Plus 2016. Я изложил свою базовую кодировку ниже:

Dim FileName as String
Dim fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject
FileName = fso.GetAbsolutePathName("cmdResources")

Ожидаемый результат:

C: \ Users \ MyName \ Documents \ A \ B \ C \ D \ Е \ Р \ cmdResources

Фактический результат:

C: \ Users \ Myname \ Documents \ cmdResources

Answer 1

Если вы хотите, чтобы VBA "искал" файл / папку в каталоге, я думаю, вам нужно использовать что-то вроде этого:

Option Explicit
Option Compare Text
Public Enum xlSearchMode
    xlFilesOnly = 0
    xlFoldersOnly = 1
    xlFilesAndFolders = 2
End Enum
Function SearchInDirectory(FName As String, Optional FoName As String, Optional SearchMode As xlSearchMode = xlFilesOnly, Optional ExactMatch As Boolean = True) As Variant
    'By Abdallah Khaled Ali El-Yaddak
    'Returns an array of strings with files/folders matching what you are searching for.
    'If nothing is found, it returns an array of one empty string element.
    '-------------'
    'FName (String): The file/folder to look for
    '[FoName] (String): The directory to search in, if omitted, CurDir will be used.
    '[SreachMode] (xlSearchMode): xlFilesOnly (default) = Look for files only | xlFoldersOnly = Look for folders only | xlFilesAndFolders = Look for both
    '[Exactmatch] (Boolean): True (default) = Look only for this string (case insenstive) | False = Sreach for any files/folders that includes this string in their name
    Dim FSO As Object, File As Object, Folder As Object, Fnames() As String, i As Long, SubNames As Variant, SubFolder As Object
    If FoName = "" Then FoName = CurDir
    If Right(FoName, 1) <> "\" Then FoName = FoName & "\"
    ReDim Fnames(1 To 1) As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Folder = FSO.GetFolder(FoName)
    If SearchMode = xlFilesOnly Or SearchMode = xlFilesAndFolders Then
        For Each File In FSO.GetFolder(Folder).Files
            If (ExactMatch And SubFolder.Name = FName) Or _
                    (Not ExactMatch And SubFolder.Name Like "*" & FName & "*") Then
                Fnames(UBound(Fnames)) = File.Path
                ReDim Preserve Fnames(1 To UBound(Fnames) + 1)
            End If
        Next
    End If
    If SearchMode = xlFoldersOnly Or SearchMode = xlFilesAndFolders Then
        For Each SubFolder In FSO.GetFolder(Folder).subFolders
            If (ExactMatch And SubFolder.Name = FName) Or _
                    (Not ExactMatch And SubFolder.Name Like "*" & FName & "*") Then
                Fnames(UBound(Fnames)) = SubFolder.Path
                ReDim Preserve Fnames(1 To UBound(Fnames) + 1)
            End If
        Next
    End If
    For Each SubFolder In FSO.GetFolder(Folder).subFolders
        SubNames = SearchInDirectory(FName, SubFolder.Path, SearchMode, ExactMatch)
        If SubNames(LBound(SubNames)) <> "" Then
            For i = LBound(SubNames) To UBound(SubNames)
                Fnames(UBound(Fnames)) = SubNames(i)
                ReDim Preserve Fnames(1 To UBound(Fnames) + 1)
            Next
        End If
    Next
    If UBound(Fnames) > 1 Then ReDim Preserve Fnames(1 To UBound(Fnames) - 1)
    SearchInDirectory = Fnames
End Function

Для тестирования вам нужно что-то вроде этого:

Sub Test()
    Dim a As Variant, i As Long
    a = SearchInDirectory("cmdResources", "C:\Users\myName\Documents\A", SearchMode:=xlFoldersOnly)
    For i = LBound(a) To UBound(a)
        Debug.Print a(i)
    Next
End Sub

Примечания:

1. Это решение не работает на MAC (проверено только на Windows)
2. Поиск займет больше времени для большегокаталоги (Количество файлов / папок внутри)