Good day.
I come to you since here I have learned quite a few details about VBA.
I have a macro that works perfectly for me, thanks to a forum on this WEB I was able to put it together according to my needs.
Its function is to open a file from a folder, generally the files have generic names, for example "BRANCH _XXX_AGOSTO" the only value that changes is the month.
What I would like is that if you cannot find the file corresponding to the current month, open the one from the previous month (based on the example it would be the month of July), either through a confirmation / notice MSBOX or directly open it.
I attach the MACRO that I have:
I come to you since here I have learned quite a few details about VBA.
I have a macro that works perfectly for me, thanks to a forum on this WEB I was able to put it together according to my needs.
Its function is to open a file from a folder, generally the files have generic names, for example "BRANCH _XXX_AGOSTO" the only value that changes is the month.
What I would like is that if you cannot find the file corresponding to the current month, open the one from the previous month (based on the example it would be the month of July), either through a confirmation / notice MSBOX or directly open it.
I attach the MACRO that I have:
VBA Code:
Dim xfolders As New Collection
Sub Buscar_Fichas_de_Datos()
Dim sPath As String
Dim xfold As Variant, arch As Variant
Dim bexist As Boolean
Dim sPartialName As String
Dim Mensaje As String
Set xfolders = Nothing
sPath = "C:\Users\Miguel Angel\Desktop\MIGUEL\FORMATOS pruebas\FICHAS pruebas"
xfolders.Add sPath 'CORRIGE DIRECTORIO
Mensaje = "¿Qué sucursal buscas?"
sPartialName = InputBox(Mensaje, "Centro de Control")
Call AddSubDir(sPath)
For Each xfold In xfolders
arch = Dir(xfold & "\" & "Sucursal" & " " & sPartialName & " " & Application.WorksheetFunction.Proper(MonthName(VBA.Month(Date), False)) & ".*")
If arch <> "" Then Exit For
Next
If arch = "" Then
MsgBox "No se encontró el archivo"
Else
ActiveWorkbook.FollowHyperlink xfold & "\" & arch
End If
End Sub
'
Sub AddSubDir(lPath As Variant)
Dim SubDir As New Collection, DirFile As Variant, sd As Variant
If Right(lPath, 1) <> "\" Then lPath = lPath & "\"
DirFile = Dir(lPath & "*", vbDirectory)
Do While DirFile <> ""
If DirFile <> "." And DirFile <> ".." Then
If ((GetAttr(lPath & DirFile) And vbDirectory) = 16) Then
SubDir.Add lPath & DirFile
End If
End If
DirFile = Dir
Loop
For Each sd In SubDir
xfolders.Add sd
Call AddSubDir(sd)
Next
End Sub
Last edited by a moderator: