Skip to content

Instantly share code, notes, and snippets.

@Susensio
Created February 3, 2022 10:38
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save Susensio/0c5745479c0c6b65b35dc060bb6002bf to your computer and use it in GitHub Desktop.
Save Susensio/0c5745479c0c6b65b35dc060bb6002bf to your computer and use it in GitHub Desktop.
Find paths in VBA with wilcard pattern in subdirectories, using DIR funcion
Public Function FindPathRecursive(StartFolder As String, Pattern As String, Optional SearchMode As VbFileAttribute = vbNormal) As String
' Función recursiva que permite buscar rutas con coincidencia de patrones, usando el widlcard comodín *
' Por ejemplo, permite buscar el archivo
' \\srvfs1\etiquetas\Bartender\Plantillas envase\UA_*\124755_*\L_Delantera.*
' con los parámetros
' StartFolder = "\\srvfs1\etiquetas\Bartender\Plantillas envase\"
' Pattern = "UA_*\124755_*\L_Delantera.*"
' devolviendo como resultado
' \\srvfs1\etiquetas\Bartender\Plantillas envase\UA_UCRANIA\124755_SPECTR-AGRO LLC\L_Delantera.btw
' en caso de no encontrar el archivo, devuelve un string vacío ""
Dim lastTokenIndex As Integer
Dim lastTokenPattern As String
Dim subFolderPattern As String
Dim subFolder As String
Dim found As String
' La carpeta de inicio siempre tiene que acabar con una contrabarra
If Right(StartFolder, 1) <> "\" Then
StartFolder = StartFolder & "\"
End If
' Si dentro del Pattern hay subcarpetas (más de un token), busco la posición del último token para hacer la busqueda recursiva
' Esto hay que hacerlo "a mano" porque la función Dir no admite wildcards (*) en subcarpetas, solo admite en el último token
' Es decir, se puede hacer Dir("carpeta\subcarpeta\*.btw")
' pero NO se puede hacer Dir("carpeta\*\*.btw")
'
' ejemplo:
' Pattern = "UA_*\124755_*\L_Delantera.*"
' _____^
' lastTokenIndex = 14
lastTokenIndex = InStrRev(Pattern, "\")
' Si existen subcarpetas en el pattern
If lastTokenIndex > 0 Then
lastTokenPattern = Right(Pattern, Len(Pattern) - lastTokenIndex)
subFolderPattern = Left(Pattern, lastTokenIndex - 1)
' Siguiendo el ejemplo, serían:
' lastTokenPattern = "L_Delantera.*"
' subFolderPattern = "UA_*\124755_*"
' Vuelvo a llamar a la función, ahora con los parámetros "reducidos"
' es decir, le quito el último token y busco la carpeta
' \\srvfs1\etiquetas\Bartender\Plantillas envase\UA_*\124755_*\
subFolder = FindPathRecursive(StartFolder, subFolderPattern, vbDirectory)
If subFolder <> "" Then
' Si encuentro la subcarpeta, ahora si, gestiono el último token y busco
' \\srvfs1\etiquetas\Bartender\Plantillas envase\UA_UCRANIA\124755_SPECTR-AGRO LLC\L_Delantera.*
found = FindPathRecursive(subFolder, lastTokenPattern, SearchMode)
End If
Else
' Caso base, solo hay un token, se llama directamente a la función Dir
' Ejemplo: si entro a la función buscando el archivo
' \\srvfs1\etiquetas\Bartender\Plantillas envase\UA_UCRANIA\124755_SPECTR-AGRO LLC\L_Delantera.*
' la función dir me devuelve:
' L_Delantera.btw
' y devuelvo la ruta completa
found = Dir(StartFolder & Pattern, SearchMode)
If found <> "" Then
found = StartFolder & found
End If
End If
FindPathRecursive = found
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment