Working with FILES
Author: Oscar Cronquist Article last updated on September 16, 2024
Table of Contents
1. Working with FILES
In this section, I will demonstrate basic file copying techniques using VBA (Visual Basic for Applications).
I will also show you how to create folders using a macro.
What's on this page
There is also a video in this article where I show these macros in detail and how to use them.
Check out category Macro for more useful posts about VBA.
Copy a file
The following macro copies a file. The file name is in cell B6, the source directory is in cell B3. The destination directory is entered in cell D3.
When you press with left mouse button on the "Copy" button the macro below runs and copies file 1.jpg from folder c:\temp\src to c:\temp\dest.
'Name macro
Sub CopyFile()
'Dimension variables and declare data types
Dim src As String, dst As String, fl As String
'Save source directory specified in cell B3 to variable src
src = Range("B3")
'Save destination directory specified in cell D3 to variable dst
dst = Range("D3")
'Save file name specified in cell B3 to variable fl
fl = Range("B6")
'Enable error handling
On Error Resume Next
'Copy file based on variables src and fl to destination folder based on variable dst and fl
FileCopy src & "\" & fl, dst & "\" & fl
'Check if an error has occurred
If Err.Number <> 0 Then
'Show error using message box
MsgBox "Copy error: " & src & "\" & fl
End If
'Disable error handling
On Error GoTo 0
End Sub
Create a button and assign a macro to it
The macro is linked to a button shown in the picture above. To insert a button follow these steps.
- Go to tab "Developer" on the ribbon.
If it is missing go to "File", press with left mouse button on "Options". Press with left mouse button on "Customize ribbon" and select "Developer" checkbox. - Press with left mouse button on the "Insert" button and the press with left mouse button on "Button" in the "Form Control" group.
- Press and hold, then drag with mouse on the worksheet to insert a button.
- Excel asks for a macro to assign to the button. If you have no macro ready for the button simply press with left mouse button on "Cancel". You can assign a macro later on.
To assign a macro to a button follow these steps.
- Press with right mouse button on on button.
- Press with left mouse button on "Assign Macro..."
- Select a macro.
- Press with left mouse button on OK.
Press with left mouse button on the button and it will run the assigned macro.
Where to copy the code?
- Copy above macro.
- Go to VB Editor (Visual Basic Editor) Shortcut keys Alt+F11 or go to tab "Developer" on the ribbon and press with left mouse button on "Visual Basic" button.
If you "Developer" tab is missing read the following article Show the Developer tab on the Microsoft website.
- Press with left mouse button on "Insert" on the menu.
- Press with left mouse button on "Module".
- Paste code to code module, see picture above.
- Exit VB Editor
- Save your workbook as a macro-enabled workbook (*.xlsm).
If you don't your macro will be gone the next time you open your workbook.
Copy and rename a file
This macro copies a file specified in cell B6 and renames the file using the value in cell D6. Cell B3 and D3 contain the source and destination paths.
'Name macro
Sub CopyRenameFile()
'Dimension variables and declare data types
Dim src As String, dst As String, fl As String
Dim rfl As String
'Save source directory specified in cell B3 to variable src
src = Range("B3")
'Save destination directory specified in cell D3 to variable dst
dst = Range("D3")
'Save file name specified in cell B3 to variable fl
fl = Range("B6")
'Save new file name specified in cell D6 to variable rfl
rfl = Range("D6")
'Enable error handling
On Error Resume Next
'Copy file based on variables src and fl to destination folder based on variable dst and name file based on value in rfl
FileCopy src & "\" & fl, dst & "\" & rfl
'Check if an error has occurred
If Err.Number <> 0 Then
'Show error using message box
MsgBox "Copy error: " & src & "\" & rfl
End If
'Disable error handling
On Error GoTo 0
End Sub
Recommended article
Recommended articles
Open Excel files in a folder [VBA]
This tutorial shows you how to list excel files in a specific folder and create adjacent checkboxes, using VBA. The […]
This tutorial shows you how to list excel files in a specific folder and create adjacent checkboxes, using VBA. The […]
Rename a file
This macro renames file new1.jpg in folder c:\temp\dest to 2.jpg.
'Name macro
Sub RenameFile()
'Dimension variables and declare data types
Dim src As String, dst As String, fl As String
Dim rfl As String
'Save source directory specified in cell B3 to variable src
src = Range("B3")
'Save old file name specified in cell B6 to variable fl
fl = Range("B6")
'Save new file name specified in cell D6 to variable rfl
rfl = Range("D6")
'Enable error handling
On Error Resume Next
'Rename file fl in directory src to rfl
Name src & "\" & fl As src & "\" & rfl
'Check if an error has occurred
If Err.Number <> 0 Then
'Show error using message box
MsgBox "Error: " & src & "\" & rfl
End If
On Error GoTo 0
End Sub
Recommended article
Recommended articles
List files in a folder
The following macro lists files in folder c:\temp\src\
'Name macro
Sub ListFilesinFolder()
'Dimension variables and declare data types
Dim Value As String
Dim strt As Range
'Save an object reference to variable strt
Set strt = Range("B6")
'Dir function returns a string representing the name of a file or folder that matches a specified pattern.
Value = Dir(Range("B3"), &H1F)
'Loop until variable Value is empty
Do Until Value = ""
'Check if variable Value is not equal to . and ..
If Value <> "." And Value <> ".." Then
strt = Value
'Save an object referencing the next cell below to variable strt
Set strt = strt.Offset(1, 0)
End If
'Repeat with next file name in folder
Value = Dir
'Keep iterating
Loop
End Sub
Recommended article
Recommended articles
Search all workbooks in a folder
Today I'll show you how to search all Excel workbooks with file extensions xls, xlsx and xlsm in a given folder for a […]
Today I'll show you how to search all Excel workbooks with file extensions xls, xlsx and xlsm in a given folder for a […]
List files in a folders and sub-folders
The following article explains how to list files in a folder and sub-folders. A UDF is a User Defined Function meaning a function that you can build and use in your workbooks.
Recommended articles
List files in a folder and subfolders [UDF]
This article demonstrates a user defined function that lists files in a ggiven folder and subfolders. A user defined function is […]
This article demonstrates a user defined function that lists files in a ggiven folder and subfolders. A user defined function is […]
Watch a video where I demonstrate the macros above
The video below shows how to use the above macros in a workbook.
How to create a folder
The following macro creates a folder named macro at path "c:\temp".
Sub CreateFolder() 'This macro creates a folder 'named macro in path c:\temp MkDir "c:\temp\macro" End Sub
If the folder already exists the following error message appears.
You can verify that the folder doesn't exist with the following code.
'Name macro Sub CheckCreateFolder() 'This macro checks if folder exists 'and if not the macro creates a folder 'named macro in path c:\temp 'Dimension variable and declare data type Dim pth As String 'Save folder path to variable pth pth = "c:\temp\macro" 'Check that the folder is non existing If Dir(pth, vbDirectory) = "" Then 'Create folder MkDir pth End If End Sub
Create folders using cell values
The following macro creates directories using values in cell range B2:B4.
'Name macro
Sub CreateFolderBasedCells()
'This macro creates folders using cell values
'Iterate through each cell in cell range B2:B4 and save to variable cell
For Each cell In Range("B2:B4")
'Check if folder is non existing
If Dir(cell, vbDirectory) = "" Then
'Create folder based on content in variable cell
MkDir cell
End If
'Continue with next cell
Next cell
End Sub
The picture below displays folder names in cell range B2:B4 that I will be using in the macro above.
This picture shows the folders in path c:\temp that the macro created.
Recommended links
- Folders and File Handling in Excel VBA
- Using VBA FileSystemObject (FSO) in Excel
- Files in a Directory
2. Compare file names in two different folder locations and their sub folders
This section demonstrates a macro that compares the content in two different folders and their subfolders. It compares the file names but not the file sizes.
The macro returns a new worksheet populated with duplicate and unique file names. In this example the picture shows the content in these two folders:
- c:\temp\
- c:\temp1\
The file information for duplicate files in the first folder is in columns A to C, the second folder is in columns D to F.
As you can see in the image above, duplicate file names are listed together. Duplicate file names in the same folder tree and the corresponding folder tree are grouped together.
Unique files from both folders are in columns A to C, below the duplicate file list. If you have folders with a lot of files and subfolders the macro may take a while to finish.
What happens when you start the macro?
- Select the first folder
- Select the second folder
- A new sheet is inserted
- The file data is saved to the new sheet
- Macro ends
Where do I save the code?
- Copy the VBA code below
- Go to the VB Editor (Alt + F11)
- Press with left mouse button on "Insert" on the menu
- Press with left mouse button on "Module"
- Paste code to the code window
- Return to excel
VBA Code
'Name macro
Sub CompareContentsofTwoFolders()
'Dimension variables and declare data types
Dim pth1 As String, pth2 As String
Dim r1 As Single, r2 As Single
Dim arrd() As Variant
Dim arru() As Variant
'Redimension array variables
ReDim arrd(0 To 5, 0)
ReDim arru(0 To 2, 0)
'Show a dialog box and ask for a path to the first folder
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
pth1 = .SelectedItems(1) & "\"
End With
'Show another dialog box and ask for a path to the second folder
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
pth2 = .SelectedItems(1) & "\"
End With
'Add a new worksheet to workbook
Sheets.Add
'Save new worksheet to object x
Set x = ActiveSheet
'Disable screen refresh while macro is running to speed things up
Application.ScreenUpdating = False
'Write text to cells and format cells
x.Range("A1") = "Duplicate files"
x.Range("A2") = "Path"
x.Range("B2") = "File name"
x.Range("C2") = "Size"
x.Range("D2") = "Path"
x.Range("E2") = "File name"
x.Range("F2") = "Size"
x.Range("A:F").Font.Bold = False
x.Range("A1:F2").Font.Bold = True
'Start macro Recursive using variable pth1 as a parameter
Recursive pth1
'Find last non-empty value in active worksheet
Lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
'Sort cell range
x.Range("A2:C" & Lrow).Sort Key1:=x.Range("B1"), Header:=xlYes
'Save values from cell range A3:C? to array variable arr1
arr1 = x.Range("A3:C" & Lrow).Value
'Clear values in cell range cell range A3:C?
x.Range("A3:C" & Lrow).Clear
'Start macro Recursive with parameter pth2
Recursive pth2
'Find last non empty cell in column A
Lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
'Sort cell range "A2:C" & Lrow
x.Range("A2:C" & Lrow).Sort Key1:=x.Range("B1"), Header:=xlYes
'Save values from cell range "A3:C" & Lrow to array variable arr2
arr2 = x.Range("A3:C" & Lrow).Value
'Clear cell range "A3:C" & Lrow from values
x.Range("A3:C" & Lrow).Clear
'For ... Next statement
For r1 = LBound(arr1, 1) To UBound(arr1, 1)
'Save boolean value False to variable chk
chk = False
'Check if variable r1 is larger than 1
'If ... Then ... End If statement
If r1 > 1 Then
'Check if the value in array variable arr1 row r1 and column 2 is equal to value in array variable arr1 row r1 -1 snd column 2
If arr1(r1, 2) = arr1(r1 - 1, 2) Then
'For ... Next statement
For r3 = UBound(arrd, 2) To LBound(arrd, 2) Step -1
'Check if value in array variable arrd row 2 column r3 is not equal to nothing AND array variable arrd row 1 column r3 is not equal to array variable arr1 row r1 column 2
'If True stop For ... Next statement
If arrd(2, r3) <> "" And arrd(1, r3) <> arr1(r1, 2) Then Exit For
'Check if array variable arrd row 1 column r3 is equal to array variable arr1 row r1 column 2
If arrd(1, r3) = arr1(r1, 2) Then
'Check if number in variable r3 is equal to the upper bound in array variable arrd
'If True add another container to array variable arrd
If r3 = UBound(arrd, 2) Then ReDim Preserve arrd(UBound(arrd, 1), UBound(arrd, 2) + 1)
'Save value in array variable arr1 row r1 column 1 to array variable arrd row 0 column r3 plus one
arrd(0, r3 + 1) = arr1(r1, 1)
'Save value in array variable arr1 row r1 column 2 to array variable arrd row 1 column r3 plus one
arrd(1, r3 + 1) = arr1(r1, 2)
'Save value in array variable arr1 row r1 column 3 to array variable arrd row 2 column r3 plus one
arrd(2, r3 + 1) = arr1(r1, 3)
'Add another column to array variable arrd
ReDim Preserve arrd(UBound(arrd, 1), UBound(arrd, 2) + 1)
'Stop For ... Next statement
Exit For
End If
Next r3
'For ... Next statement
For r3 = UBound(arru, 2) To LBound(arru, 2) Step -1
'Check if value in array variable arru row 2 column r3 is not equal to nothing AND array variable arru row 1 column r3 is not equal to array variable arr1 row r1 column 2
'If True stop For ... Next statement
If arru(2, r3) <> "" And arru(1, r3) <> arr1(r1, 2) Then Exit For
'Check if array variable arru row 1 column r3 is equal to array variable arr1 row r1 column 2
If arru(1, r3) = arr1(r1, 2) Then
'Check if number in variable r3 is equal to the upper bound in array variable arru
'If True add another container to array variable arru
If r3 = UBound(arru, 2) Then ReDim Preserve arru(UBound(arru, 1), UBound(arru, 2) + 1)
'Save value in array variable arr1 row r1 column 1 to array variable arru row 0 column r3 plus one
arru(0, r3 + 1) = arr1(r1, 1)
'Save value in array variable arr1 row r1 column 2 to array variable arru row 1 column r3 plus one
arru(1, r3 + 1) = arr1(r1, 2)
'Save value in array variable arr1 row r1 column 3 to array variable arru row 2 column r3 plus one
arru(2, r3 + 1) = arr1(r1, 3)
'Add another column to array variable arru
ReDim Preserve arru(UBound(arru, 1), UBound(arru, 2) + 1)
'Stop For ... Next statement
Exit For
End If
Next r3
'Go to statement
GoTo jmp
End If
End If
'For ... Next statement
For r2 = LBound(arr2, 1) To UBound(arr2, 1)
'Check if array variable arr2 row r2 column 2 is equal to array variable arr1 row r1 column 2
If arr2(r2, 2) = arr1(r1, 2) Then
'If ... Then ... Else ... End If statement. Check if variable chk is equal to boolean value False
If chk = False Then
'Save values from array variable arr1 row r1 to array variable arrd
arrd(0, UBound(arrd, 2)) = arr1(r1, 1)
arrd(1, UBound(arrd, 2)) = arr1(r1, 2)
arrd(2, UBound(arrd, 2)) = arr1(r1, 3)
'Continue here if variable chk is not False
Else
'Save nothing to array variable arrd
arrd(0, UBound(arrd, 2)) = ""
arrd(1, UBound(arrd, 2)) = ""
arrd(2, UBound(arrd, 2)) = ""
End If
'Save values from array variable arr2 row r2 to array variable arrd
arrd(3, UBound(arrd, 2)) = arr2(r2, 1)
arrd(4, UBound(arrd, 2)) = arr2(r2, 2)
arrd(5, UBound(arrd, 2)) = arr2(r2, 3)
'Clear value in array variable arr2 row r2 column 1
arr2(r2, 1) = ""
'Add another column to array variable arrd
ReDim Preserve arrd(UBound(arrd, 1), UBound(arrd, 2) + 1)
'Save boolean value True to variable chk
chk = True
End If
Next r2
'Check if variable Chk is equal to boolean value False
If chk = False Then
'Save value from array variable arr1 row r1 to array variable arru
arru(0, UBound(arru, 2)) = arr1(r1, 1)
arru(1, UBound(arru, 2)) = arr1(r1, 2)
arru(2, UBound(arru, 2)) = arr1(r1, 3)
'Add another column to array variable arru
ReDim Preserve arru(UBound(arru, 1), UBound(arru, 2) + 1)
End If
'Go to location
jmp:
Next r1
'For ... Next statement
For r2 = LBound(arr2, 1) To UBound(arr2, 1)
'Check if value in array variable arr2 row r2 column 1 is not equal to nothing
If arr2(r2, 1) <> "" Then
'Save values from array variable arr2 row r2 to array variable arru
arru(0, UBound(arru, 2)) = arr2(r2, 1)
arru(1, UBound(arru, 2)) = arr2(r2, 2)
arru(2, UBound(arru, 2)) = arr2(r2, 3)
'Add another column to array variable arru
ReDim Preserve arru(UBound(arru, 1), UBound(arru, 2) + 1)
End If
Next r2
'Save values in array variable arrd to a cell range with the same size as the array and the upper left cell is A3
x.Range("A3").Resize(UBound(arrd, 2) + 1, UBound(arrd, 1) + 1) = Application.Transpose(arrd)
'Save text to column A
x.Range("A" & UBound(arrd, 2) + 3) = "Unique files"
x.Range("A" & UBound(arrd, 2) + 4) = "Path"
x.Range("B" & UBound(arrd, 2) + 4) = "File name"
x.Range("C" & UBound(arrd, 2) + 4) = "Size"
x.Range("A" & UBound(arrd, 2) + 3 & ":C" & UBound(arrd, 2) + 4).Font.Bold = True
'Save values from array variable arru to a cell range
x.Range("A" & UBound(arrd, 2) + 5).Resize(UBound(arru, 2) + 1, UBound(arru, 1) + 1) = Application.Transpose(arru)
'Resize columns A:F widths based on text
x.Columns("A:F").AutoFit
'Show changes on the worksheet
Application.ScreenUpdating = True
End Sub
The following macro is a recursive macro that starts for each subfolder in the given folders. You need both macros to be able to iterate through subfolders.
'Name macro and parameters
Sub Recursive(FolderPath As String)
'Dimension variables and declare data types
Dim Value As String, Folders() As String
Dim Folder As Variant, a As Long
'Resize variable Folders
ReDim Folders(0)
'Check if last two characters in variable FolderPath is equal to \\
'If True stop macro
If Right(FolderPath, 2) = "\\" Then Exit Sub
'Returns a String representing the name of a file, directory, or folder that matches a specified pattern or file attribute, or the volume label of a drive.
Value = Dir(FolderPath, &H1F)
'Do Until ... Loop statement
Do Until Value = ""
'Check if value is equal to . or ..
If Value = "." Or Value = ".." Then
Else
'Check if value is a folder
If GetAttr(FolderPath & Value) = 16 Or GetAttr(FolderPath & Value) = 48 Then
'Save value to array variable Folders
Folders(UBound(Folders)) = Value
'Add another container to array variable Folders
ReDim Preserve Folders(UBound(Folders) + 1)
'Continue here if Value is not a folder
Else
'Go to the last non empty value in column A and then move a cell down
Lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
'Save folder path to Column A row Lrow
ActiveSheet.Range("A" & Lrow) = FolderPath
'Save Value to Column B row Lrow
ActiveSheet.Range("B" & Lrow) = Value
'Save file size to Column C row Lrow
ActiveSheet.Range("C" & Lrow) = FileLen(FolderPath & Value)
End If
End If
Value = Dir
Loop
'Iterate through all folders saved in array variable Folders
For Each Folder In Folders
'Start macro Recursive with parameter Folder and a "\"
Recursive FolderPath & Folder & "\"
'Continue with next Folder
Next Folder
End Sub
3. Which Excel files in folder are password protected?
This article explains how to check if Excel files in a given folder are password protected. The image above shows the folder path in cell C4 that the macro will use.
Press with left mouse button on the button "Select a folder" to run the macro, a dialog box asks for the folder path. The folder path will be shown in cell C4 and the result will be displayed in cell range B6:C7 and cells below.
rahul jadhav asks: How can we identify any protected excel file before opening using macro VBA (e.g. i have a folder with multiple excel files i need to find out using macro how many files are password protected before opening and it should give result on separate workbook.)
is it possible using excel vba macro?
is it possible using excel vba macro?
As far as I know, you can't check if an Excel file is password protected without opening the file. The macro opens workbooks in a folder, check if password protected and then close the workbook. One by one.
This technique can be slow if you have many Excel files saved in the folder, however, it is much faster than doing this manually.
3.1 VBA Code
'Name macro
Sub CheckWbook()
'Dimension variables and declare data types
Dim Value As String, a As Single
'The With ... End With statement allows you to write shorter code by referring to an object only once instead of using it with each property.
With Application.FileDialog(msoFileDialogFolderPicker)
'Ask for a folder path
.Show
'Save folder path to variable myfolder
myfolder = .SelectedItems(1) & "\"
End With
'Save folder path to cell C4
Range("C4") = myfolder
'Clear cell range B7:C1048576
Range("B7:C" & Rows.Count) = ""
'Save 0 (zero) to variable a
a = 0
'Dir function returns a string representing the name of a file or folder that matches a specified pattern.
Value = Dir(myfolder)
'Keep iterating while variable Value is not empty
Do Until Value = ""
'Check if variable Value is equal to "." or ".."
If Value = "." Or Value = ".." Then
'Continue here if variable Value is NOT equal to "." or ".."
Else
'Check if file extension is xls, xlsx or xlsm
If Right(Value, 3) = "xls" Or Right(Value, 4) = "xlsx" Or Right(Value, 4) = "xlsm" Then
'Enable error handling
On Error Resume Next
'Open workbook based on variable myfolder and Value using password "zzzzzzzzzzzz"
Workbooks.Open Filename:=myfolder & Value, Password:="zzzzzzzzzzzz"
'If an error is returned write "Yes" to cell in column C based on variable a
If Err.Number > 0 Then
Range("C7").Offset(a, 0).Value = "Yes"
End If
'Close workbook without saving any changes
Workbooks(Value).Close False
'Disable error handling
On Error GoTo 0
' Save file name to cell in column B based on variable a
Range("B7").Offset(a, 0).Value = Value
'Add 1 to variable a
a = a + 1
End If
End If
'Continue with next file or folder
Value = Dir
'Go back to "Do Until"
Loop
End Sub
3.2 Where to put the code?
- Copy VBA code. (CTRL + c)
- Press shortcut keys Alt + F11 to open the Visual Basic Editor.
- Doublepress with left mouse button on your workbook in the "Project Explorer" window.
- Press with left mouse button on "Insert" on the top menu.
- Press with left mouse button on "Module" to insert a module to current workbook.
- Paste code to module, see image above. CTRL + v.
3.3 List password-protected workbooks and worksheets in folder
The following VBA macro creates a list of workbooks and worksheets located in a given folder. It also returns "Yes" if a workbook or a worksheet is password-protected.
The button named "Select a folder" displayed in the image above allows you to run the macro, press with left mouse button on the button to start the macro. The macro then asks for a folder to work with, note that it won't continue with sub-directories for that particular folder.
3.4 VBA Code
'Name macro
Sub PassWordWorkbook()
'Dimension variables and declare data types
Dim Value As String, a As Single
'The With ... End With statement allows you to write shorter code by referring to an object only once instead of using it with each property
With Application.FileDialog(msoFileDialogFolderPicker)
'Ask for a folder path
.Show
'Save folder path to variable myfolder
myfolder = .SelectedItems(1) & "\"
End With
'Save a reference of current workbook to object ws
Set ws = ActiveSheet
'Save folder path to cell C4
Range("C4") = myfolder
'Clear cell range B7:C1048576
Range("B7:C" & Rows.Count) = ""
'Save 0 (zero) to variable a
a = 0
'Dir function returns a string representing the name of a file or folder that matches a specified pattern.
Value = Dir(myfolder)
'Keep iterating while variable Value is not empty
Do Until Value = ""
'Check if variable Value is equal to "." or ".."
If Value = "." Or Value = ".." Then
Else
'Continue here if variable Value is NOT equal to "." or ".."
If Right(Value, 3) = "xls" Or Right(Value, 4) = "xlsx" Or Right(Value, 4) = "xlsm" Then
'Enable error handling
On Error Resume Next
'Open workbook based on variable myfolder and Value using password "zzzzzzzzzzzz"
Workbooks.Open Filename:=myfolder & Value, Password:="zzzzzzzzzzzz"
'If an error is has occured write "Yes" to cell in column C based on variable a
If Err.Number > 0 Then
ws.Range("D7").Offset(a, 0).Value = "Yes"
End If
'Disable error handling
On Error GoTo 0
' Save file name to cell in column B based on variable a
ws.Range("B7").Offset(a, 0).Value = Value
'Add 1 to variable a
a = a + 1
'Enable error handling
On Error Resume Next
'Iterate through each worksheet in current workbook
For Each sht In ActiveWorkbook.Worksheets
'Save worksheet name to column C based on variable a
ws.Range("C7").Offset(a, 0).Value = sht.Name
'Check if worksheet is password protected
If sht.ProtectContents Then
'Unprotect worksheet
sht.Unprotect ""
'Check if an error has occured
If Err.Number > 0 Then
'Save "Yes" to column D based on variable a
ws.Range("D7").Offset(a, 0).Value = "Yes"
End If
End If
'Add 1 to variable a
a = a + 1
'Continue with next worksheet
Next sht
'Disable error handling
On Error GoTo 0
'Close workbook
Workbooks(Value).Close False
End If
End If
'Continue with next file or folder
Value = Dir
'Go back to "Do Until"
Loop
End Sub
FILECOPY examples
Working with FILES
Table of Contents Working with FILES Compare file names in two different folder locations and their sub folders Which Excel […]
Table of Contents Working with FILES Compare file names in two different folder locations and their sub folders Which Excel […]
DIR examples
Compare file names in two different folder locations and their sub folders
Today I would like to share a macro that compares the content in two different folders and their subfolders. It […]
Today I would like to share a macro that compares the content in two different folders and their subfolders. It […]
Copy data from workbooks in folder and subfolders
Table of Contents Copy data from workbooks in folder and subfolders Move data to workbooks Copy each sheet in active […]
Table of Contents Copy data from workbooks in folder and subfolders Move data to workbooks Copy each sheet in active […]
Customize Excel maze
Terry wants to make a different sized maze and I think that is a great idea. Perhaps you remember that I […]
Terry wants to make a different sized maze and I think that is a great idea. Perhaps you remember that I […]
Filter duplicate files in a folder and subfolders
This is a follow up to my last post Compare file names in two different folder locations and their subfolders, the obvious […]
This is a follow up to my last post Compare file names in two different folder locations and their subfolders, the obvious […]
Find and replace strings in file names, folder name and subfolders
The following two macros FindReplace() and Recursive() let you rename files and folders recursively based on a search string. The […]
The following two macros FindReplace() and Recursive() let you rename files and folders recursively based on a search string. The […]
How to save specific multiple worksheets to a pdf file programmatically
This article demonstrates macros that save worksheets to a single pdf file. What's on this webpage Export all worksheets in […]
This article demonstrates macros that save worksheets to a single pdf file. What's on this webpage Export all worksheets in […]
List files in a folder and subfolders [UDF]
This article demonstrates a user defined function that lists files in a ggiven folder and subfolders. A user defined function is […]
This article demonstrates a user defined function that lists files in a ggiven folder and subfolders. A user defined function is […]
List files in folder and create hyperlinks (VBA)
Table of Contents List files in a folder and create hyperlinks (VBA) How to navigate quickly in a complex workbook […]
Table of Contents List files in a folder and create hyperlinks (VBA) How to navigate quickly in a complex workbook […]
Open Excel files in a folder [VBA]
This tutorial shows you how to list excel files in a specific folder and create adjacent checkboxes, using VBA. The […]
This tutorial shows you how to list excel files in a specific folder and create adjacent checkboxes, using VBA. The […]
Search all workbooks in a folder
Today I'll show you how to search all Excel workbooks with file extensions xls, xlsx and xlsm in a given folder for a […]
Today I'll show you how to search all Excel workbooks with file extensions xls, xlsx and xlsm in a given folder for a […]
Search all workbooks in a folder and sub folders – VBA
This article demonstrates macros that allow you to search for a text string(s) in multiple worksheets and workbooks located in […]
This article demonstrates macros that allow you to search for a text string(s) in multiple worksheets and workbooks located in […]
Search for a file in folder and subfolders – UDF
Table of Contents Search for a file in folder and sub folders - User Defined Function Search for a file […]
Table of Contents Search for a file in folder and sub folders - User Defined Function Search for a file […]
Unzip files in folder and subfolders
The VBA macro demonstrated in this article lets you unzip all zip files in a folder to a destination folder […]
The VBA macro demonstrated in this article lets you unzip all zip files in a folder to a destination folder […]
Which Excel files in folder are password protected?
This article explains how to check if Excel files in a given folder are password protected. The image above shows […]
This article explains how to check if Excel files in a given folder are password protected. The image above shows […]
Working with comments – VBA
Did you know that you can select all cells containing comments in the current sheet? Press F5, press with left […]
Did you know that you can select all cells containing comments in the current sheet? Press F5, press with left […]
Working with FILES
Table of Contents Working with FILES Compare file names in two different folder locations and their sub folders Which Excel […]
Table of Contents Working with FILES Compare file names in two different folder locations and their sub folders Which Excel […]
This extensive vba reference list provides detailed information including syntax, arguments, return values, and examples for Visual Basic for Applications.
Files and folders category
Search all workbooks in a folder
Today I'll show you how to search all Excel workbooks with file extensions xls, xlsx and xlsm in a given folder for a […]
Today I'll show you how to search all Excel workbooks with file extensions xls, xlsx and xlsm in a given folder for a […]
Search for a file in folder and subfolders – UDF
Table of Contents Search for a file in folder and sub folders - User Defined Function Search for a file […]
Table of Contents Search for a file in folder and sub folders - User Defined Function Search for a file […]
Copy data from workbooks in folder and subfolders
Table of Contents Copy data from workbooks in folder and subfolders Move data to workbooks Copy each sheet in active […]
Table of Contents Copy data from workbooks in folder and subfolders Move data to workbooks Copy each sheet in active […]
Macro category
How to create an interactive Excel chart
Table of Contents How to create an interactive Excel chart How to filter chart data How to build an interactive […]
Table of Contents How to create an interactive Excel chart How to filter chart data How to build an interactive […]
Excel calendar
Table of Contents Excel monthly calendar - VBA Calendar Drop down lists Headers Calculating dates (formula) Conditional formatting Today Dates […]
Table of Contents Excel monthly calendar - VBA Calendar Drop down lists Headers Calculating dates (formula) Conditional formatting Today Dates […]
Split data across multiple sheets – VBA
Table of Contents Split data across multiple sheets - VBA Add values to worksheets based on a condition - VBA […]
Table of Contents Split data across multiple sheets - VBA Add values to worksheets based on a condition - VBA […]
Vba category
Search all workbooks in a folder
Today I'll show you how to search all Excel workbooks with file extensions xls, xlsx and xlsm in a given folder for a […]
Today I'll show you how to search all Excel workbooks with file extensions xls, xlsx and xlsm in a given folder for a […]
How to create an interactive Excel chart
Table of Contents How to create an interactive Excel chart How to filter chart data How to build an interactive […]
Table of Contents How to create an interactive Excel chart How to filter chart data How to build an interactive […]
Excel calendar
Table of Contents Excel monthly calendar - VBA Calendar Drop down lists Headers Calculating dates (formula) Conditional formatting Today Dates […]
Table of Contents Excel monthly calendar - VBA Calendar Drop down lists Headers Calculating dates (formula) Conditional formatting Today Dates […]
Excel categories
40 Responses to “Working with FILES”
Leave a Reply
How to comment
How to add a formula to your comment
<code>Insert your formula here.</code>
Convert less than and larger than signs
Use html character entities instead of less than and larger than signs.
< becomes < and > becomes >
How to add VBA code to your comment
[vb 1="vbnet" language=","]
Put your VBA code here.
[/vb]
How to add a picture to your comment:
Upload picture to postimage.org or imgur
Paste image link to your comment.
It was so easy to understand. I believe we can do the same by using FilesystemObject.
Ankit,
Thank you!
Yes, you are right: Creating a FileSystemObject
Hi guys can the above copy and rename be modified to overwrite if file exist on destination folder? Thanks in advance
To overwrite try
cheers
Fabrizio
To overwrite try
cheers
Fabrizio
Hi,
Thanks for the code, really helpfull.
How do i select multiple files for example from A1:A2000
is this possible?
Thanks in advance.
You know the answer? If yes can you please post here
thank you
Hello... Even though its been years since your post I will post a link when I had the same question and it was solved.
https://www.excelforum.com/excel-programming-vba-macros/1092620-copy-rename-multiple-files-in-excel.html#post4126148
Thanks, really helpfull
Sua
From : Indonesia
Hi,
Thanks for the code, really helpfull.
How do i select multiple files for example from A1:A2000
is this possible?
Thanks in advance.
[…] the file to another directory. The original code was posted here, but it only works for one cell. Copy/Rename a file (excel vba) | Get Digital Help - Microsoft Excel resource Basically I have a list of file names from a directory, and those files I want to copy and rename […]
Hey Oscar,
Thanks for posting this. I am also curious how you could update the Copy and Rename VBA to work for multiple files. Any chance you could enlighten us?
-Stephen
I Use copy files template but i need to move more than 100 file so i try to change range but there's something missing so kindly i need to code very very soon to complete my work
hello,,
when I used the above code for very load folder it show error massage ,, what should I do ?
Have I change data type or what ?
amira
What is the error message?
Oscar ,, Thanx for your reply
this is the dir link,,
https://postimg.org/delete/ls52omldk/
This is perfect, thanks! However, like the rest of the users I'd love to copy/rename multiple files based on a cell range (e.g., D6:D100). So essentially creating a loop until the last "rename" value is reached. How should I modify the code to accomplish this?
https://www.excelforum.com/excel-programming-vba-macros/1092620-copy-rename-multiple-files-in-excel.html#post4126148
what should be the codes for copying sub-folders layout from specific path into another folder, noting that the destination folder is variable based on a value inside the excel sheet.
Hi Oscar,
This looks like it will work for what I would like to do, but I would need to be able to ignore the first several characters as well as the last several of each file. When I create new files they are given an automatic random number sequence at the start and end of the file name. I would like to compare the new files to a master list of files. Would this be possible?
Thanks
This code does not work for me.
Let me elaborate my scenario, want to copy an excel file from ShareDrive
and paste that same file in C Drive. Do not want to change the file name.
On Error Resume Next
FileCopy sFolder & "\" & nFile, dFolder & "\" & nFile
If Err.Number 0 Then
MsgBox "Copied Successfull", vbInformation, "Status"
End If
On Error GoTo 0
This is very helpful! Is there a way to modify it to check each worksheet in a file as well? I found this snippet to check all sheets but I haven't been able to successfully insert it into this macro. https://www.thespreadsheetguru.com/the-code-vault/2014/12/17/determine-if-workbook-or-worksheet-is-password-protected-with-excel-vba
Thanks!
Hi Oscar,
This is really a nice piece of coding! I want to add the column "filedatetime" to have a complete comparison (filelen 'could' be the same, but the newest file would have the benefit.
I am not sure where to adapt the array redim's:
Sub CompareContentsofTwoFolders() Dim pth1 As String, pth2 As String Dim r1 As Single, r2 As Single Dim arrd() As Variant Dim arru() As Variant 'Redims changed ReDim arrd(0 To 8, 0) ReDim arru(0 To 6, 0) 'Ask for first folder (path) pth1 = "Z:\sync\newsync\USB Profile #4\" 'Ask for second folder (path) pth2 = "Z:\sync\oldsync\USB Profile #4\" 'Insert a new sheet Sheets.Add Set x = ActiveSheet 'Get a list of first folder´s content to a sheet Application.ScreenUpdating = False x.Range("A1") = "Duplicate files" x.Range("A2") = "Path" x.Range("B2") = "File name" x.Range("C2") = "Size" 'here datstamp added x.Range("D2") = "Datestamp" x.Range("E2") = "Path" x.Range("F2") = "File name" x.Range("G2") = "Size" x.Range("H2") = "Datestamp" x.Range("A:H").Font.Bold = False x.Range("A1:H2").Font.Bold = True Recursive pth1 'Sort list and then move it to an array lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row x.Range("A2:D" & lrow).Sort Key1:=x.Range("B1"), Header:=xlYes 'Move range to array arr1 = x.Range("A3:D" & lrow).Value 'Clear contents on sheet x.Range("A3:D" & lrow).Clear 'Get a list of the second of folder and save it to an array Recursive pth2 'Sort list and then move it to an array lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row x.Range("A2:D" & lrow).Sort Key1:=x.Range("B1"), Header:=xlYes 'Move range to array arr2 = x.Range("A3:D" & lrow).Value 'Clear contents on sheet x.Range("A3:D" & lrow).Clear 'Loop files in first folder For r1 = LBound(arr1, 1) To UBound(arr1, 1) chk = False 'First value in array? If r1 > 1 Then 'Check if value is equal to previous value If arr1(r1, 2) = arr1(r1 - 1, 2) Then 'Find the last value in dupes array arrd(?,2) For r3 = UBound(arrd, 2) To LBound(arrd, 2) Step -1 If arrd(2, r3) <> "" And arrd(1, r3) <> arr1(r1, 2) Then Exit For If arrd(1, r3) = arr1(r1, 2) Then If r3 = UBound(arrd, 2) Then ReDim Preserve arrd(UBound(arrd, 1), UBound(arrd, 2) + 1) arrd(0, r3 + 1) = arr1(r1, 1) arrd(1, r3 + 1) = arr1(r1, 2) arrd(2, r3 + 1) = arr1(r1, 3) arrd(3, r3 + 1) = arr1(r1, 4) ReDim Preserve arrd(UBound(arrd, 1), UBound(arrd, 2) + 1) Exit For End If Next r3 'Find the last value in uniques array arru(?,2) For r3 = UBound(arru, 2) To LBound(arru, 2) Step -1 If arru(2, r3) <> "" And arru(1, r3) <> arr1(r1, 2) Then Exit For If arru(1, r3) = arr1(r1, 2) Then If r3 = UBound(arru, 2) Then ReDim Preserve arru(UBound(arru, 1), UBound(arru, 2) + 1) arru(0, r3 + 1) = arr1(r1, 1) arru(1, r3 + 1) = arr1(r1, 2) arru(2, r3 + 1) = arr1(r1, 3) '******************************** HERE IT GOES WRONG arru(3, r3 + 1) = arr1(r1, 4) ReDim Preserve arru(UBound(arru, 1), UBound(arru, 3) + 1) '******************************** It is not clear to me how to resize the array in a proper way? Exit For End If Next r3 GoTo jmp End If End If 'Loop files in second folder For r2 = LBound(arr2, 1) To UBound(arr2, 1) 'Check if values are equal If arr2(r2, 2) = arr1(r1, 2) Then 'First match in arr2 If chk = False Then arrd(0, UBound(arrd, 2)) = arr1(r1, 1) arrd(1, UBound(arrd, 2)) = arr1(r1, 2) arrd(2, UBound(arrd, 2)) = arr1(r1, 3) arrd(3, UBound(arrd, 2)) = arr1(r1, 4) 'There are previous matches in arr2 Else arrd(0, UBound(arrd, 2)) = "" arrd(1, UBound(arrd, 2)) = "" arrd(2, UBound(arrd, 2)) = "" arrd(3, UBound(arrd, 2)) = "" End If 'Save arr2 in dupes array arrd arrd(4, UBound(arrd, 2)) = arr2(r2, 1) arrd(5, UBound(arrd, 2)) = arr2(r2, 2) arrd(6, UBound(arrd, 2)) = arr2(r2, 3) arrd(7, UBound(arrd, 2)) = arr2(r2, 4) 'Delete first value in arr2 arr2(r2, 1) = "" 'arr2(r2, 2) = "" 'arr2(r2, 3) = "" ReDim Preserve arrd(UBound(arrd, 1), UBound(arrd, 2) + 1) chk = True End If Next r2 'No match, save arr1 values to uniques array arru If chk = False Then arru(0, UBound(arru, 2)) = arr1(r1, 1) arru(1, UBound(arru, 2)) = arr1(r1, 2) arru(2, UBound(arru, 2)) = arr1(r1, 3) arru(3, UBound(arru, 2)) = arr1(r1, 4) ReDim Preserve arru(UBound(arru, 1), UBound(arru, 2) + 1) End If jmp: Next r1 'Add unique values in arr2 (non empty values) to arru For r2 = LBound(arr2, 1) To UBound(arr2, 1) If arr2(r2, 1) <> "" Then arru(0, UBound(arru, 2)) = arr2(r2, 1) arru(1, UBound(arru, 2)) = arr2(r2, 2) arru(2, UBound(arru, 2)) = arr2(r2, 3) arru(3, UBound(arru, 2)) = arr1(r1, 4) ReDim Preserve arru(UBound(arru, 1), UBound(arru, 2) + 1) End If Next r2 'Return values to sheet x.Range("A3").Resize(UBound(arrd, 2) + 1, UBound(arrd, 1) + 1) = Application.Transpose(arrd) x.Range("A" & UBound(arrd, 2) + 3) = "Unique files" x.Range("A" & UBound(arrd, 2) + 4) = "Path" x.Range("B" & UBound(arrd, 2) + 4) = "File name" x.Range("C" & UBound(arrd, 2) + 4) = "Size" x.Range("D" & UBound(arrd, 2) + 4) = "Datestamp" x.Range("A" & UBound(arrd, 2) + 3 & ":C" & UBound(arrd, 2) + 4).Font.Bold = True x.Range("A" & UBound(arrd, 2) + 5).Resize(UBound(arru, 2) + 1, UBound(arru, 1) + 1) = Application.Transpose(arru) 'Autofit cell width x.Columns("A:G").AutoFit Application.ScreenUpdating = True End Sub Sub Recursive(FolderPath As String) Dim Value As String, Folders() As String Dim Folder As Variant, a As Long ReDim Folders(0) If Right(FolderPath, 2) = "\\" Then Exit Sub Value = Dir(FolderPath, &H1F) Do Until Value = "" If Value = "." Or Value = ".." Then Else If GetAttr(FolderPath & Value) = 16 Or GetAttr(FolderPath & Value) = 48 Then Folders(UBound(Folders)) = Value ReDim Preserve Folders(UBound(Folders) + 1) Else lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1 ActiveSheet.Range("A" & lrow) = FolderPath ActiveSheet.Range("B" & lrow) = Value ActiveSheet.Range("C" & lrow) = FileLen(FolderPath & Value) ActiveSheet.Range("D" & lrow) = FileDateTime(FolderPath & Value) End If End If Value = Dir Loop For Each Folder In Folders Recursive FolderPath & Folder & "\" Next Folder End SubI would very, very much appreciate the help.
Johan
Johan
'* HERE IT GOES WRONG arru(3, r3 + 1) = arr1(r1, 4) '* It is not clear to me how to resize the array in a proper way? ReDim Preserve arru(UBound(arru, 1), UBound(arru, 3) + 1)You don't need to change that line.
ReDim Preserve arru(UBound(arru, 1), UBound(arru, 2) + 1)Hi I just created a loop and used you code copy a file to a new name ".xlsm"- all worked well. However, whenever I open the files all I see is a white screen - if I move to the left an right - I can see the field/cell content. Question, why am I getting the White screen in all 50 newly created files with the following code?
lr = Cells(Rows.Count, 17).End(xlUp).Row
For x = 2 To lr
'Rename file
rfl = ThisWorkbook.Sheets("Setup").Range("Q" & x).Value
On Error Resume Next
FileCopy src, dst & rfl & ".xlsm"
If Err.Number 0 Then
MsgBox "Copy error: " & src & "\" & rfl
End If
On Error GoTo 0
Next
JLS,
Have you tried to open a file on another computer? Do you get the same result?
Hi,
Kindly provide the vba comments for checking in a directory no of word documents password protected or not..
Thank you,
Regards,
Shiva Sundar
Hello Oscar, Thank you for your great code. Is there a way to prohibit the code to compare files from different folders?
c:\temp\folder1 - c:\temp1\folder1
c:\temp\folder2 - c:\temp1\folder2
But not
c:\temp\folder1 - c:\temp1\folder2
c:\temp\folder2 - c:\temp1\folder1
Morris
I believe you need to compare the paths in order to extract duplicate files.
Works great, exactly what i was needing. I learned a lot form looking at your code.
Joe,
Thank you for commenting.
2019....and this code is still super useful! Thanks so much if you're still reading this :)
James,
Thanks!
Hello,
Thanks for the copy and rename file macro. Having a slight problem with it, though.
When I used your example with the cells, a jpg file and the temp folder all is good.
As soon as I copy my folder from the desktop as txt from Win Explorer it runs into the error message. I want to copy xlsm-files.
Would you have any suggestion on that? Checked the folders again and again and also copied the old file names, therefore this shouldn't be an issue, I think. Might be the excel files to copy the issue? As the temp folder works it should be ok on the desktop as well, but nothing.
KR
Matthias
Got it sorted, the extension wasn't right. Thanks again.
Is there a way to add 2 additions in here.
1. Check recursively all subfolders.
2. Check if the files are using a defined password and flag those that are not?
Hello Oscar,
Really nice coding indeed.
Is there a possibility to ignore the extension in those files ?
I would like to know if a software has produce all the files. The names stay the same, only the extension changes.
Thanks!
If the file is XLSX or XLSM or XLSB there is a much faster way to check without opening the file.
Public Function IsPasswordProtected(strFilePath As String) As Boolean
' Open file for byte reading, check length
Dim fileInt As Integer:
Dim arrFile(0 To 7) As Byte
fileInt = FreeFile
Open strFilePath For Binary Access Read As #fileInt
If LOF(fileInt) < 8 Then
Exit Function
End If
' Fetch the first bytes
Get #fileInt, , arrFile
Close #fileInt
' Compare with Encrypted OLE2 / Multistream Compound File magic
' D0 CF 11 E0 A1 B1 1A E1
Dim arrSignature(0 To 7) As Byte, i As Integer
For i = LBound(arrSignature) To UBound(arrSignature)
arrSignature(i) = Choose(i + 1, &HD0, &HCF, &H11, &HE0, &HA1, &HB1, &H1A, &HE1)
Next
If StrConv(arrFile, vbUnicode) = StrConv(arrSignature, vbUnicode) Then
IsPasswordProtected = True
End If
End Function
If the excel files are NOT 'XLS
Then a faster way is to check the first 8 bytes of the file
Public Function IsPasswordProtected(strFilePath As String) As Boolean Dim fileInt As Integer: Dim arrFile(0 To 7) As Byte Dim arrSignature(0 To 7) As Byte Dim i As Integer fileInt = FreeFile Open strFilePath For Binary Access Read As #fileInt If LOF(fileInt) < 8 Then Close #fileInt Exit Function End If 'Fetch the first bytes Get #fileInt, , arrFile Close #fileInt ' Compare with Encrypted OLE2 / Multistream Compound File magic ' D0 CF 11 E0 A1 B1 1A E1 For i = LBound(arrSignature) To UBound(arrSignature) arrSignature(i) = Choose(i + 1, &HD0, &HCF, &H11, &HE0, &HA1, &HB1, &H1A, &HE1) Next If StrConv(arrFile, vbUnicode) = StrConv(arrSignature, vbUnicode) Then IsPasswordProtected = True End If End FunctionGary Lee,
thank you for commenting.