Creare elenco di files di cartelle del PC e aggiungerli all'Hyperlink. (per poterli aprire dall'elenco stesso)

Da usare soprattutto con le versione di excel dalla 2007 compresa e successive, versioni che non "conoscono" l'oggetto FileSearch impiegato in diverse routine di articoli sul sito.

E' vero che esiste anche l'articolo Cercare e Selezionare una Cartella (Folder o Directory) (vedi) che serve anche per crearsi un elenco dei files contenuti in una determinata cartella, e che i lettori attenti avranno saputo modificare i vari articoli sul tema "elencofile-hiperlink" per adattarli alle nuove versioni di Excel, ma visto che esistono incertezze (???) di alcuni lettoti su come procedere, presento qui due routine che possono risolvere il tema.

Sub CaricaNomiFile()

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)  'con fd apriamo la finestra per la selezione della cartella che ci interessa
Dim CartellaSelezionata As Variant

With fd
If .Show = -1 Then
For Each CartellaSelezionata In .SelectedItems
miacartella = CartellaSelezionata
Next
End If
End With

folderspec = miacartella
Dim fs, f, Nomefile, Cartella
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set Cartella = f.Files
'sotto: si inizia il ciclo che per ogni file (Nomefile) presente in Cartella
For Each Nomefile In Cartella

'sotto: controlliamo l'estensione dei file: se corrispondono all'estensione cercata, ne carichiamo il percorso completo in una cella del 'foglio attivo


If Right(Nomefile, 3) = "xls" Then

Dim iRow, icol As Integer
iRow = 5
icol = 1
While Cells(iRow, icol).Value <> ""
iRow = iRow + 1
Wend

Cells(iRow, icol) = miacartella & "\" & Nomefile.Name
End If
Next
Iperlink  'ora chiamiamo la routine per aggiungere il collegamento hyperlink ai nomi su scritti
Set fs = Nothing
Set Cartella = Nothing
Set f = Nothing
Set fd = Nothing
End Sub

 

'e questa la seconda routine che scorre l'elenco realizzato con la routine precedente, e se il file scorso nel ciclo corrisponde come 'estensione al voluto, gli aggiungiamo l'iperlink; ho diviso queste istruzioni solo per rendere più comprensibili le due operazioni, ma 'basta modificare la routin sopra come mostrato nella parte "Modifica"

Sub Iperlink()
tr = Range("A65536").End(xlUp).Row
For N = 5 To tr
If Right(Cells(N, 1), 3) = "xls" Then
Q = Cells(N, 1).Value
W = Cells(N, 1).Value
ActiveSheet.Cells(N, 1).Hyperlinks.Add Anchor:=ActiveSheet.Cells(N, 1), Address:=Q, TextToDisplay:=W

End If
Next
End Sub

 

 

Modifica : (le due routine sono state integrate)

Sub CaricaNomiFile2()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim CartellaSelezionata As Variant

With fd
If .Show = -1 Then
For Each CartellaSelezionata In .SelectedItems
folderspec = CartellaSelezionata
Next
End If
End With

Dim fs, f, Nomefile, Cartella
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set Cartella = f.Files

For Each Nomefile In Cartella
If Right(Nomefile, 3) = "xls" Then

Dim iRow, icol As Integer
iRow = 5
icol = 1
While Cells(iRow, icol).Value <> ""
iRow = iRow + 1
Wend

Cells(iRow, icol) = miacartella & "\" & Nomefile.Name
Q = Cells(iRow, icol).Value
W = Cells(iRow, icol).Value
ActiveSheet.Cells(iRow, icol).Hyperlinks.Add Anchor:=ActiveSheet.Cells(iRow, icol), Address:=Q, TextToDisplay:=W

End If
Next

Set fs = Nothing
Set Cartella = Nothing
Set f = Nothing
Set fd = Nothing
End Sub

 


Cosa c'à da dire:

1) ho impostato le istruzioni per lavorare con file xls (if Right(Nomefile, 3) = "xls") basta modificare l'estensione con l'estensione che ci pare purchè con estensione a tre lettere, altrimenti, per i nuovi file Office a 4 lettere di estensione occorre anche modificare l'istruzione if Right(Nomefile, 4) = "xlsm"). Meglio ovviamente predisporre un automatismo per selezionare una determinata estensione affidandola ad una variabile da usare per il confronto dei file ed assegnare detta variabile al controllo con l'istruzione Right, naturalmente variando la lunghezza da usare come secondo elemento della funzione, quindi per esempio, se useremo una combobox dove leggere le estensioni previste, potremmo avere:

  Dim este as string
  este = ComboBox1.Text   'combobox dove avremo caricato con Additem tutte le estenzioni che vorremo
  if este = "" then exit sub
  lunga = Len(este)
  if Right(Nomefile, lunga) = este Then

2) Nelle istruzioni ho omesso di indicare il nome del foglio su cui lavorare, assumendo il foglio come il foglio attivo, ma sarebbe opportuno indicare sempre anche il nome del foglio, es.
    While Sheets("FoglioTuo").Cells(iRow, icol).Value <> "" ecc.

3) ho istruito come riga  iniziale in cui incollare la riga 5 del foglio attivo e come colonna la colonna A (la 1) ma ognuno destinerà gli intervalli dove gli aggraderà, modificando i valori nelle istruzioni.

Spero tanto che un certo sig. Giuseppe si decida ad applicarsi di più.

 

 

 

buon lavoro a tutti.

prelevato sul sito www.ennius.altervista.org