.
Macro que permite buscar una cadena de caracteres en el nombre de ficheros dentro de una carpeta, anteriormente se presentó una variante que hacía al revés recorriendo cada uno de los archivos de una carpeta buscándolo en la hoja de Excel una vez encontrado establecía la ruta y hacía link al archivo; en este caso busca una cadena de caracteres en los nombres de ficheros de una carpeta determinada, si lo encuentra hace un link al archivo.
Recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.
if (payload.eventType == ‘subscribe’) {
// Add code to handle subscribe event.
} else if (payload.eventType == ‘unsubscribe’) {
// Add code to handle unsubscribe event.
}
if (window.console) { // for debugging only
window.console.log(‘YT event: ‘, payload);
}
}
En la siguiente variable se establece el path de la carpeta donde debe buscar los archivos, en este caso se utiliza el explorador de archivos de Windows para seleccionar la carpeta, también se puede asignar directamente si es más conveniente según las necesidades de cada programador.
path1 = CreateObject(«shell.application»).browseforfolder(0, «Seleccione Carpeta», 0).Items.Item.Path
La macro una vez encontrado el archivo que contiene la cadena de caracteres buscadas, específicamente en este caso busca un código (Column A) que está inserto en el nombre de cada uno de los nombres de ficheros, una vez encontrado el fichero lo renombra.
Por favor considera la posibiliad de aportar para sostener el sitio, desde el link del final del post se puede descargar el ejemplo de macro, cada usuario puede adaptarlo a sus necesidades, la codificación está abierta y es de libre, se brinda en forma gratuita.
⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Quizá sea de utilidad también
Pasar datos de listbox a hoja Excel con Enter
Leer un archivo TXT separado con coma
Mostrar en el mismo listbox, suma, cuenta y promedio
⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Luego de renombrar el archivo modificando el nombre del archivo, pasa al principio del nombre
La macro crea un link al archivo para ello, con las siguientes variables se establece que texto se mostrará en el link y cual es la fila donde está la cadena de texto buscada en la hoja de Excel, se usan los códigos siguientes:
La variable texhipv guarda el texto que se verá en el link, dire contiene la fila donde está el registro que coincide con el archivo y luego se hace el link al archivo, con el código que sigue, si se observa se ve como se utilizan las variables para formar el link al archivo; a continuación se muestra el código completo.
Este último código es el que crea el hiperlink, hipertexto. hipervinculo o link al fichero, se podrá observar que en la última parte del código se utiliza la variable texhipv que es el texto que se mostrará en el link; el código donde se insertará el link se determina con la siguiente expresión:
a.Range(«A» & dire)
Sub hiperlinkficheroYURL()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim path1 As String, ruta As String, texhipv As String
Set a = Sheets(ActiveSheet.Name)
uf = a.Range(«A» & Rows.Count).End(xlUp).Row
‘path1 = ActiveWorkbook.Path & «324 PruebaHyper»
path1 = CreateObject(«shell.application»).browseforfolder(0, «Seleccione Carpeta», 0).Items.Item.Path
If path1 = «» Then
MsgBox «No ha seleccionado directorio carpeta Excel, seleccione directorio .», , «AVISO»
Exit Sub
End If
NunFich = 0
num = 0
For x = 5 To uf
cadbus = Cells(x, «A»)
Set fso = CreateObject(«Scripting.FileSystemObject»)
Set carpeta = fso.getfolder(path1)
Set ficheros = carpeta.Files
For Each ficheros In ficheros
b = ficheros.Name
nomold = path1 & «» & b
cadbusnew = » » & cadbus & » «
esp1 = InStr(b, cadbusnew)If esp1 > 0 Then
esp2 = InStr(esp1 + 1, b, » «)
num = Mid(b, esp1 + 1, esp2 – 1 – esp1)
pp = Left(b, esp1 – 1)
sp = Mid(b, esp2 + 1)
nomnew = path1 & «» & num & » » & pp & » » & sp
Name nomold As nomnew
busco = num
Set codigo = a.Range(«A5:A» & uf).Find(busco, LookIn:=xlValues, LookAt:=xlWhole)
If Not codigo Is Nothing Then
a.Range(«F» & codigo.Row) = nomnew
texhipv = a.Range(«A» & codigo.Row)
dire = codigo.Row
a.Hyperlinks.Add Anchor:=a.Range(«A» & dire), Address:=nomnew, TextToDisplay:=texhipv
NunFich = NunFich + 1
End If
GoTo sal:
End If
Next ficheros
sal:
Next x
Set carpeta = Nothing
Set ficheros = Nothing
MsgBox («Se encontraron » & NunFich & » ficheros en la carpteta seleccionada»), vbInformation, «AVISO»
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim path1 As String, ruta As String, texhipv As String
Set a = Sheets(ActiveSheet.Name)
uf = a.Range(«A» & Rows.Count).End(xlUp).Row
‘path1 = ActiveWorkbook.Path & «324 PruebaHyper»
path1 = CreateObject(«shell.application»).browseforfolder(0, «Seleccione Carpeta», 0).Items.Item.Path
If path1 = «» Then
MsgBox «No ha seleccionado directorio carpeta Excel, seleccione directorio .», , «AVISO»
Exit Sub
End If
NunFich = 0
num = 0
For x = 5 To uf
cadbus = Cells(x, «A»)
Set fso = CreateObject(«Scripting.FileSystemObject»)
Set carpeta = fso.getfolder(path1)
Set ficheros = carpeta.Files
For Each ficheros In ficheros
b = ficheros.Name
nomold = path1 & «» & b
cadbusnew = » » & cadbus & » «
esp1 = InStr(b, cadbusnew)
If esp1 > 0 Then
esp2 = InStr(esp1 + 1, b, » «)
num = Mid(b, esp1 + 1, esp2 – 1 – esp1)
pp = Left(b, esp1 – 1)
sp = Mid(b, esp2 + 1)
nomnew = path1 & «» & num & » » & pp & » » & sp
Name nomold As nomnew
busco = num
Set codigo = a.Range(«A5:A» & uf).Find(busco, LookIn:=xlValues, LookAt:=xlWhole)
If Not codigo Is Nothing Then
a.Range(«F» & codigo.Row) = nomnew
texhipv = a.Range(«A» & codigo.Row)
dire = codigo.Row
a.Hyperlinks.Add Anchor:=a.Range(«A» & dire), Address:=nomnew, TextToDisplay:=texhipv
NunFich = NunFich + 1
End If
GoTo sal:
End If
Next ficheros
sal:
Next x
Set carpeta = Nothing
Set ficheros = Nothing
MsgBox («Se encontraron » & NunFich & » ficheros en la carpteta seleccionada»), vbInformation, «AVISO»
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
.
If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.
Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends