@Ozz_Kozz
With the permission of all involved, in addition, for example,
from Mr.Subodh Tiwari (@Subodh_Tiwari_sktneer) with a small example file that I found on the Internet.
Read out the file name of a directory with VBA and write it in Excel
Source: January 31, 2017 by Marco Schade
https://www.makro-excel.de/2017/01/31/dateinamen-eines-rechner-mit-vba-auslesen-und-in-excel-schreib...
With a small macro you can easily write all file names including the file extensions in Excel. You only need to add the following macro to a module of your Excel file. Alternatively, you can also use the sample file attached to this article to read file names with VBA.
There are two important points to consider before you start. Before running the macro, you have to change the folder name in the VBA code. In the example, the macro would otherwise search for the folder with the name “Folder Name” in the “C: \” drive and, if available, list the files in this folder in column A from row 1. If the folder path does not exist, you will receive the error message "Runtime error’ 76 ‘: Path not found".
Runtime error 76
Read out file names with VBA
Also make sure that there is no content in column A in the table, otherwise it may be overwritten! Would you like the file names not from line 1, but e.g. only write from line 5. Also change the code in the VBA code from
lngline = 1
on
lngline = 5
from.
All of the source code for this macro is as follows:
List Sub Files ()
Dim lngLine As Long
Dim objFileSystem As Object
Dim obj Directory As Object
Dim obj List of files As Object
Dim obj file As Object
Set objFileSystem = CreateObject ("scripting.FileSystemObject")
Set objDirectory = objFileSystem.GetFolder ("C: \ folder name")
Set objFileList = objDirectory.Files
lngline = 1
For Each objfile In objfilelist
If Not objFile Is Nothing Then
ActiveSheet.Cells (lngLine, 1) = objFile.Name
lngline = lngline 1
End If
Next obj file
End Sub
If you do not want to write all file names in Excel, you can also exclude certain file extensions or file names with a further small modification. To do this, change the line with the VBA code:
If Not objFile Is Nothing Then
in
If Not objFile Is Nothing And Right (LCase (objFile.Name), 4) = ".jpg" Then
from.
The addition And Right (LCase (objDatei.Name), 4) = ".jpg" leads to the restriction that only files with the ending ".jpg" are written in Excel. If you want to write all file names except a certain extension in Excel, add the command “Not”. Example: And Not Right (LCase (objDatei.Name), 4) = ".jpg"
The macro presented here only reads the file names of the current folder. The names of sub-folders and the files in them are not taken into account. The files in sub-folders can of course be also be taken into account. In this case, however, a somewhat more extensive change to the VBA source code is required.
Read files from subdirectories
In order to be able to read the file names from sub-folders, an additional procedure is required which is called for each individual sub-folder. Because the files in the main folder are not taken into account in this example, the two macros may have to be combined. To do this, call the second procedure at the end of the first macro using the command
Call Read out subfolder (objDirectory)
on. The additional VBA procedure required is then called via this program line.
Sub Subfolder readout (ByVal strFile path As String)
Dim objFileSystem As Object
Dim obj Directory As Object
Dim obj subfolder As Object
Dim obj file As Object
Dim i As Long
Set objFileSystem = CreateObject ("Scripting.FileSystemObject")
Set objDirectory = objFileSystem.getfolder (strFilePath)
If Cells (Rows.Count, 1) .End (xlUp) .Row> 1 Then
i = Cells (Rows.Count, 1) .End (xlUp) .Row 1
Else
i = 1
End If
For Each objSubfolders In objDirectory.subfolders
For Each objFile In objSubfolder.Files
If Not objFile Is Nothing And Not Right (LCase (objFile.Name), 4) = ".jpg" Then
ActiveSheet.Cells (i, 1) = objFile.Name
ActiveSheet.Cells (i, 2) = objSubfolder.Path
i = i 1
End If
Next obj file
Call UnterFolderAuslesen (objUunterfolder.Path)
If Cells (Rows.Count, 1) .End (xlUp) .Row> 1 Then
i = Cells (Rows.Count, 1) .End (xlUp) .Row 1
Else
i = 1
End If
Next obj subfolder
End Sub
I hope that you will get on with your project with this additional information.
Wish everyone involved a nice day / night with health, joy and love.
Nikolino
I know I don't know anything (Socrates)
