Working with FILES
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
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
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
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.
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
Files and folders category
Today I'll show you how to search all Excel workbooks with file extensions xls, xlsx and xlsm in a given folder for a […]
Table of Contents Search for a file in folder and sub folders - User Defined Function Search for a file […]
Table of Contents Copy data from workbooks in folder and subfolders Move data to workbooks 1. Copy data from workbooks […]
Macro category
Table of Contents How to create an interactive Excel chart How to filter chart data How to build an interactive […]
Table of Contents Excel monthly calendar - VBA Calendar Drop down lists Headers Calculating dates (formula) Conditional formatting Today Dates […]
Table of Contents Split data across multiple sheets - VBA Add values to worksheets based on a condition - VBA […]
Vba category
Today I'll show you how to search all Excel workbooks with file extensions xls, xlsx and xlsm in a given folder for a […]
Table of Contents Search for a file in folder and sub folders - User Defined Function Search for a file […]
Table of Contents How to create an interactive Excel chart How to filter chart data How to build an interactive […]
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.
Contact Oscar
You can contact me through this contact form
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:
I would very, very much appreciate the help.
Johan
Johan
You don't need to change that line.
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
Gary Lee,
thank you for commenting.