I am trying to loop through all subfolders within a folder, compiling all the names of the files. I'm having a bit of trouble though as I have adapted this code from a macro that only loops through one folder and compiles file names. Thank you greatly for your time!
Sub FindFiles()
Cells(1, 1).Select
Dim F As String
Dim G As String
F = Dir("C:\Users\z003nttv\Desktop\Folder\" & "*")
Do While Len(F) > 0
Do While Len(G) > 0
G = Dir(F & "*.*")
ActiveCell.Formula = G
ActiveCell.Offset(1, 0).Select
G = Dir()
Loop
F = Dir()
Loop
End Sub
Found the answer at the following site:
https://www.extendoffice.com/documents/excel/2994-excel-list-all-files-in-folder-and-subfolders.html
Hope it may lend some help..very user friendly!
I was working on this code before you posted the link and had second thoughts posting my work. So I checked out the link you posted. I believe that the code I wanted to post is succinct & addresses the point far better. Hence here you go
Step 1. The Reference
Step2. The Code.
Sub FindFiles()
Dim fso As FileSystemObject
Dim Folder As Folder
Dim Files As Files
Dim path, s As String
'' Input Path : Please change as needed
path = Sheets("Sheet1").Cells(1, 2).Value
Set fso = New FileSystemObject
Set Basefolder = fso.GetFolder(path)
Set SubFolders = Basefolder.SubFolders
Dim i As Integer
i = 1
For Each Folder In SubFolders
Set Files = Folder.Files
For Each File In Files
With Sheets("Sheet1")
.Cells(i, 1).Value = Folder
.Cells(i, 2).Value = File
i = i + 1
Next File
Next Folder
End Sub
Related
Looking help - a way to pull the string from the filename and perform a task using the string part of the formula manually.
Right now I can pull the file from the folder and use the string part of my program
C:\ XXXX_555_GGGGG.xlsx ( extraxt '555")
C:\ XXXX_101_GGGGG.xlsx (extraxt"101")
....cont!
manually we can do this for each of the files:
Sub Combined()
wb.Sheets("Sheet1").Range("b2").Value = _
Application.SumIfs(Sheet1.Columns(2), Sheet1.Columns(1), "555")
End Sub
Sub Combined1()
wb.Sheets("Sheet1").Range("b3").Value = _
Application.SumIfs(Sheet1.Columns(2), Sheet1.Columns(1), "101")
End Sub
Looking for a better way to automated this:
Open the folder
pull the string from filename path ( file one) ( i.e '555')
use the string part of my sum formula
next file
Thanks in advance
You can use Dir() to loop over files in a folder
Sub tester()
Dim c As Range, f, arr, wb As Workbook
Set wb = ThisWorkbook 'or whatever
Set c = wb.Sheets("Sheet1").Range("B2")
f = Dir("C:\FolderTest\*.xlsx")
Do While Len(f) > 0
arr = Split(f, "_")
If UBound(arr) = 2 Then 'check file pattern
c.Value = Application.SumIfs(Sheet1.Columns(2), Sheet1.Columns(1), arr(1))
Set c = c.Offset(1, 0)
End If
f = Dir()
Loop
End Sub
I am relatively amateur at VBA and am using a code provided by tech on the net.
I have an Excel document with files names in column B (not always one file type) which I am trying to ensure I have copies and the correct revision in a designated folder.
Currently, the code works perfectly for a specific folder location, but the files referenced in the Excel spreadsheet exist in various other folders and thus I need to create a code that can search a main folder and loop through the various sub-folders.
See current code below for reference.
Sub CheckIfFileExists()
Dim LRow As Integer
Dim LPath As String
Dim LExtension As String
Dim LContinue As Boolean
'Initialize variables
LContinue = True
LRow = 8
LPath = "K:\location\main folder\sub folder \sub folder"
LExtension = ".pdf"
'Loop through all column B values until a blank cell is found
While LContinue
'Found a blank cell, do not continue
If Len(Range("B" & CStr(LRow)).Value) = 0 Then
LContinue = True
'Check if file exists for document title
Else
'Place "No" in column E if the file does NOT exist
If Len(Dir(LPath & Range("B" & CStr(LRow)).Value & LExtension)) = 0 Then
Range("E" & CStr(LRow)).Value = "No"
'Place "Yes" in column E if the file does exist
Else
Range("E" & CStr(LRow)).Value = "Yes"
End If
End If
LRow = LRow + 1
Wend
End Sub
There are over 1000 documents, so simple windows searches is not ideal, and I have reviewed several previous questions and cannot find an answer that helps.
Okay, my answer is going to revolve around 2 comments from your question. This will serve only as a basis for you to improve upon and adapt to how you need it.
N.B SKIP TO THE BOTTOM OF MY ANSWER TO SEE THE FULL WORKING CODE
The first comment is:
I need to create a code that can search a main folder and loop through the various sub-folders.
The code i will explain below will take a MAIN FOLDER, that you will need to specify, and then it will loop through ALL subfolders of the parent directoy. So you will not need to worry about specific sub folders. As long as you know the name of the file you want to access, the code will find it regardless.
The second is a line of your code:
LPath = "K:\location\main folder\sub folder \sub folder"
This line of code will form part of a UDF (User Defined Function) that i will display below.
Step 1
Re-label LPath to be the what is called the "Host Folder". This is the MAIN FOLDER.
For Example: Host Folder = "K:\User\My Documents\" (Note the backslash at the end is needed)
Step 2
Set a reference to Microsoft Scripting Runtime in 2 places:
i) In the code
Set FileSystem = CreateObject("Scripting.FileSystemObject")
ii) In the VBA Editor. (To a basic google search on how to find the reference library in the VBA editor)
Step 3
This is the main element, this is a sub routine that will find the file no matter where it is, providing a file name and host folder has been provided.
Sub DoFolder(Folder)
Dim SubFolder
For Each SubFolder In Folder.SubFolders
DoFolder SubFolder
Next
Dim File
For Each File In Folder.Files
If File.Name = "Specify Name.pdf" Then
Workbooks.Open (Folder.path & "\" & File.Name), UpdateLinks:=False
Workbooks(File.Name).Activate
Exit Sub
End If
Next
End Sub
The code above will simply open the file once it has found it. This was just my own specific use; adapt as necessary.
MAIN CODE
Option Explicit
Dim FileSystem As Object
Dim HostFolder As String
Sub FindFile()
HostFolder = "K:\User\My Documents\"
Set FileSystem = CreateObject("Scripting.FileSystemObject")
DoFolder FileSystem.GetFolder(HostFolder)
End Sub
Sub DoFolder(Folder)
Dim SubFolder
For Each SubFolder In Folder.SubFolders
DoFolder SubFolder
Next
Dim File
For Each File In Folder.Files
If File.Name = "Specify Name.pdf" Then
Workbooks.Open (Folder.path & "\" & File.Name), UpdateLinks:=False
Workbooks(File.Name).Activate
Exit Sub
End If
Next
End Sub
You can chop this up how you see fit, you can probably throw it into your sub CheckIfFileExists() or just use it on its own.
Let me know how you get along so i can help you understand this further
As we know, we use Find() method to find whether a string or any Microsoft Excel data type exists in an excel.
(Usually we do it on set of data)
I want to know if any such method available when we loop through folder(of files) using Dir function.
Situation:
I have an excel - 'FileNames.xlsx' in which 'Sheet1' has names of files having extensions .pdf/.jpg/.jpeg/.xls/.xlsx/.png./.txt/.docx/ .rtf in column A.
I have a folder named 'Folder' which has most(or all) of the files from 'FileNames.xlsx'.
I have to check whether all the file-names mentioned in the 'FileNames.xlsx' exist in 'Folder'.
For this I have written the below VBScript(.vbs):
strMessage =Inputbox("Enter No. of Files in Folder","Input Required")
set xlinput = createobject("excel.application")
set wb123 =xlinput.workbooks.Open("E:\FileNames.xlsx")
set sh1 =wb123.worksheets("Sheet1")
For i = 2 to strMessage +1
namei = sh1.cells(i,1).value
yesi = "E:\Folder"+ namei +
If namei <> yesi Then
sh1.cells(i,1).Interior.Color = vbRed
Else
End If
Next
msgbox "Success"
xlinput.quit
As I wasn't able to get the required Output I tried it recording a small Excel VBA Macro. (Changed FileNames.xlsx to FileNames.xlsm)
Sub LoopThroughFiles()
Dim lastRow As Long
lastRow = Sheets("Sheet1").UsedRange.Rows.Count
Dim MyFolder As String
Dim filename As Range
Dim MyFile As String
MyFolder = "E:\Folder"
For Each filename In Worksheets("Sheet1").Range("A2A:" & lastRow)
MyFile = Dir(MyFolder & "\*.xlsx")
'Here I actually need to pass all file extensions to Dir
Do While MyFile <> ""
If filename = MyFile Then
'Do Nothing
Else
filename.Interior.Color = vbRed
MyFile = Dir
Next
End Sub
The above is a failed attempt.
I thought of trying it with method similar to Find()
Sub LoopThroughFiles()
Dim lastRow As Long
'Dim LastFile As Long
'Is there need of it (LastFile variable)? I kept this variable
'to save (prior known) count of files in folder.
lastRow = Sheets("Sheet1").UsedRange.Rows.Count
'LastFile = 'Pass count of Files in folder to this variable.
Dim fileName As Range
For Each fileName In Worksheets("Sheet1").Range("A2:A" & lastRow)
Dim rngFnder As Range
On Error Resume Next
'Error at below line.
Set rngFnder = Dir("E:\Folder\").Find(filename)
'This line gives me error 'Invalid Qualifier'
'I am trying to use method similar to Find()
If rngFnder Is Nothing Then
filename.Interior.Color = vbRed
End If
Next
End Sub
But, I couldn't achieve the result. Can anyone tell me is there any such function available to 'Find' whether all filenames in an excel exist in a folder after looping through folder using Dir?
As per my knowledge, Dir function works with only one file extension at a time.
Is it possible to use Dir function for multiple file extensions at a time?
Expected Output:
Assume I have 8 filenames in 'FileNames(.xlsx/.xlsm)'. Out of which Arabella.pdf and Clover.png are not found in 'Folder', Then I want to color cells for these filenames in red background in excel as in below image.
Sub LoopThroughFiles()
Dim lastRow As Long
lastRow = Sheets("Sheet1").UsedRange.Rows.Count
Dim MyFolder As String
Dim filename As Range
Dim MyFile As String
MyFolder = "E:\Folder"
For Each filename In Worksheets("Sheet1").Range("A2:A" & lastRow)
MyFile = MyFolder & "\" & filename
If Not FileExists(MyFile) Then
filename.Interior.Color = vbRed
End If
Next
End Sub
Public Function FileExists(strFullpathName As String) As Boolean
If Dir(strFullpathName) <> "" Then
FileExists = True
Else
FileExists = False
End If
End Function
You can output a list of the files that are contained in the folder. I found a really helpful tutorial on that here: http://software-solutions-online.com/2014/03/05/list-files-and-folders-in-a-directory/#Jump1
If you then loop through both the original and the output lists and look for a match. Easiest is to first colour them all red, and un-colour the matches. Else you would need an additional if-statement that states: When you reach the last element in the original list, and no match has been found, then colour red.
Edit: For continuity's sake I copied the code bits of the link I mentioned above:
Getting all file names form within 1 folder:
Sub Example1()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("D:StuffFreelancesWebsiteBlogArraysPics")
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'print file name
Cells(i + 1, 1) = objFile.Name
'print file path
Cells(i + 1, 2) = objFile.Path
i = i + 1
Next objFile
End Sub
I'm fairly new to VBA and macro's, so I'm writing a post here to hopefully get some help and tips for my solution. My problem is as follows:
I need to copy an uncertain amount of cells containing data from excel-files in folders and subfolders to paste in an excel-"mother"-file:
"All files that contain data is in one folder and it's subfolders. the cells to be copied in theese files ALWAYS start at row 40, and are in cells A, B, C and D. How many rows that need to be copied however is uncertain."
What I'm looking for is code that loops through a folder and it's subfolders looking for files to get data from. I'm also thinking that inside this loop I will later write code to collect data from each individual file.
SO, what I'm looking for is:
- Code to loop through a folder and subfolders to collect data from file.
- Code that finds last row with data and copies all data from start to this last row. I'm thinking something like: "A40:D & UncertainRange"
All help is greatly appreciated.. afterall I'm still a VBA Noob.
Have a great weekend, and may all of your problems be solved by scripting.
Good day.
Here's a command to identify the last row in an Excel sheet that has data:
lastRow = ActiveWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
To loop through your data beginning on row 40 of each file you can then use something like this:
lastRow = ActiveWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For iRow = 40 to lastRow
destinationSheet.Cells(outputRow, 1) = sourceSheet.Cells(iRow, 1)
destinationSheet.Cells(outputRow, 2) = sourceSheet.Cells(iRow, 2)
destinationSheet.Cells(outputRow, 3) = sourceSheet.Cells(iRow, 3)
destinationSheet.Cells(outputRow, 4) = sourceSheet.Cells(iRow, 4)
outputRow = outputRow + 1
Next iRow
To loop through files, use something like this:
Sub mySub()
Dim strFolder As String
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\"
.title = "Please select a folder..."
.Show
If .SelectedItems.Count > 0 Then
strFolder = .SelectedItems(1) & "\"
Else
Exit Sub
End If
End With
Dim myobject As Object
Set myobject = CreateObject("Scripting.FileSystemObject")
Set mysource = myobject.GetFolder(strFolder)
Application.Workbooks.Open ("c:\motherWorkbook.xlsx")
For Each MyFile In mysource.Files
''' Do Something with files in main folder
Next
' Subfolders
For Each mySubFolder In mysource.Subfolders
Set mysource = myobject.GetFolder(mySubFolder.Path)
For Each MyFile In mysource.Files
''' Do Something with files in sub folders
Next
Next
End Sub
have a look at this link: http://online-vba.de/vba_readfolder.php - change sRootPath with your directory without \ at the end
The code I wrote can display filenames into a sheet, but I want to remove the extension when displayed. I know that should be a little correction, but I burned out trying options. Can Somebody tell me where exaclty I must add a piece of code that I miss please? My attempt of code below. Many similar issues on the net, but I can not manage to find it.Thanks in advance....
Option Explicit
Sub fileNames_in_folder()
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Dim fldpath
Dim fld As Object, fil As Object, fso As Object, j As Long
fldpath = "C:\"
On Error Resume Next
Thisworkbook.Sheets("1").Activate
'start count row
j = 11
Set fso = CreateObject("scripting.filesystemobject")
Set fld = fso.getfolder(fldpath)
For Each fil In fld.Files
'here I have to add something due to expell the ".extension"
Cells(j, 34).Value = fso.GetBaseName(fil.path)
'count behaviour
j = j + 1
Next
Columns("AH").AutoFit
End Sub
A file name without extension you can get with GetBaseName Method:
Cells(j, 34).Value = fso.GetBaseName(fil.path)
If InStrRev(fil.Path, ".") <> 0 Then
Cells(j, 34).Value = Left(fil.Path, InStrRev(fil.Path, ".") - 1)
End If
Assuming the presence "." in the file name.
i.e. C:\Test.txt will be shown as C:\Test