creare un elenco di file contenuti in una cartella specifica

Question

qualcuno sa se esiste un modo, con l'uso di vba, di creare l'elenco dei file (anche solo xlsx/xsl) che risultano presenti in un determinato percorso?

Answer 1

Ciao Nikita,

qualcuno sa se esiste un modo, con l'uso di vba, di creare l'elenco dei file (anche solo xlsx/xsl) che risultano presenti in un determinato percorso?

• Alt+F11 per aprire l'editor di VBA
• Alt+IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

 '========>>

Option Explicit

'-------->>

Public Sub Tester()

Dim WB As Workbook 

Dim SH As Worksheet 

Dim oFSO As Object 

Dim oFolder As Object 

Dim oFile As Object 

Dim fDialog As FileDialog 

Dim arrFile() As Variant 

Dim sFileExt As String 

Dim iCtr As Long 

Const sNomeFoglio As String = "**Elenco\_File**" 

Set fDialog = Application.FileDialog(msoFileDialogFolderPicker) 

fDialog.AllowMultiSelect = False 

If fDialog.Show Then 

    Set oFSO = CreateObject("Scripting.FileSystemObject") 

    Set oFolder = oFSO.GetFolder(fDialog.SelectedItems(1))   

    For Each oFile In oFolder.Files 

        sFileExt = oFSO.GetExtensionName(oFile) 

        If sFileExt = "xlsx" Or sFileExt = "xls" Then 

            iCtr = iCtr + 1 

            ReDim Preserve arrFile(1 To iCtr) 

            arrFile(iCtr) = oFile.Name 

        End If 

    Next oFile 

    If CBool(iCtr) Then 

        Set WB = ThisWorkbook 

        With WB 

            If SheetExists(sNomeFoglio, WB) Then 

                Set SH = WB.Sheets(sNomeFoglio) 

                SH.UsedRange.ClearContents 

            Else 

                Set SH = .Sheets.Add(After:=.Sheets(.Sheets.Count)) 

                SH.Name = sNomeFoglio 

            End If 

        End With 

        With SH 

            .Range("A1").Value = oFolder.Path 

            .Range("A2").Resize(iCtr).Value = Application.Transpose(arrFile) 

        End With 

    End If 

End If 

End Sub

'--------->>

Public Function SheetExists(sSheetName As String, _

Optional ByVal WB As Workbook) As Boolean 

On Error Resume Next 

If WB Is Nothing Then 

    Set WB = ThisWorkbook 

End If 

SheetExists = CBool(Len(WB.Sheets(sSheetName).Name)) 

End Function

'<<========  

• Alt+Q per chiudere l'editor di VBA e tornare a Excel
• Salva il file con l’estensione xlsm
• Alt+F8 per aprire  la finestra di gestione delle macro
• Seleziona Tester
• Esegui

===

Regards,

Norman

![](https://learn-attachment.microsoft.com/api/attachments/01b6113a-82f5-4ae8-90e9-cfa983792d9a?platform=QnA

Answer 2

Ciao Nikita,

corretto un piccolo errore in fase di incollaggio sulla sub precedente (in effetti me la segnava in rosso)

TI ADORO!!!

PERFETTO

Mi fa piacere che tu abbia risolto il problema e ti ringrazio per il cortese riscontro.

Alla prossima.

===

Regards,

Norman

Answer 3

corretto un piccolo errore in fase di incollaggio sulla sub precedente (in effetti me la segnava in rosso)

TI ADORO!!!

PERFETTO

Answer 4

ciao Norman

grazie come sempre,

ho fatto come hai scritto e mi da function non definita