VBA Help - Code to Look into Folder Directory for File and Download to Specific Folder Location

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
578
Office Version
2016
Platform
MacOS
Hello All,

I have a project which requires a tool that is capable of looking at a set list of file names, a specified sub folder and seeing if the file exists, if so, then make a copy of the file to a specific Directory and update the workbook that I will trigger the code form with a "Saved Down as of" date.

I have mocked up a quick spreadsheet with some of the test cases and not sure the best way to get this done.

A simplified explanation of steps

1. With the workbook "Download Files Tool" trigger the macro
2. Code will look at Sheet1, Range("A2:A28") for the list of Filenames and go one by one to the directory specificed in the adjacent cell
2a. Not sure if this is necessary to have the code look into a specific folder rather than looking into all subfolder of the main folder and seeing if the filename exists?
3. If the file is found, save a copy to the folder directory: C:\Users\JThunder\Downloaded Files
3a. Files can all be thrown into the same folder and do not need to be placed into sub folders, there will be no duplicate file names
4. Code will then update Column C "Saved Down As Of" with the formula =Now() and copy/Paste the date as values to log when the file was placed into the destination folder
5. The code will be triggered at various times through out the day so the code will need to look at column C, if date is blank then look for the file, if date has been populated then skip to the next filename

Unique Occurrences
1. In the event a user emails me and says they made an update to the file, I would manually delete the date in column C and re-run the tool and have the code override the saved file in the destination folder.


Hopefully the above explanation was clear.

Excel Workbook
ABC
1File NameSub Folder DirectorySaved Down as of:
2TBT v7.5 - Australia8/29/2018 9:11
3TBT v7.5 - Brazil
4TBT v7.5 - Canada
5TBT v7.5 - Canada Games
6TBT v7.5 - Canada NL
7TBT v7.5 - China
8TBT v7.5 - France
9TBT v7.5 - Germany & Austria
10TBT v7.5 - Hong Kong8/27/2018 11:11
11TBT v7.5 - India
12TBT v7.5 - Italy
13TBT v7.5 - Japan
14TBT v7.5 - Korea8/29/2018 12:11
15TBT v7.5 - Norway
16TBT v7.5 - Philippines
17TBT v7.5 - Poland
18TBT v7.5 - Singapore
19TBT v7.5 - Spain & Portugal
20TBT v7.5 - Sweden
21TBT v7.5 - Switzerland
22TBT v7.5 - Taiwan
23TBT v7.5 - Thailand
24TBT v7.5 - Turkey
25TBT v7.5 - United Kingdom
26TBT v7.5 - UK Productions
27TBT v7.5 - WBTT Games
28TBT v7.5 - WHV (UK)
Sheet1
 

Leith Ross

Well-known Member
Joined
Mar 17, 2008
Messages
1,869
Office Version
2010, 2007
Platform
Windows
Hello Johnny Thunder,

Add a new VBA module to your workbook and then copy and paste the macro code below into it. You can add a button to your worksheet to call the macro.

Code:
Sub SaveCopies()


    Dim Cell    As Range
    Dim File    As Object
    Dim Folder  As Variant
    Dim Rng     As Range
    Dim RngEnd  As Range
    Dim Wks     As Worksheet
    
        Set Wks = ActiveSheet
        
        Set Rng = Wks.Range("A2")
        Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
        
        If RngEnd.Row < Rng.Row Then Exit Sub Else Set Rng = Wks.Range(Rng, RngEnd)
        
        With CreateObject("Shell.Application")
            For Each Cell In Rng
                If Cell.Offset(0, 2) = Empty Then
                    Folder = .Namespace(Cell.Offset(0, 1))
            
                    Set File = Folder.ParseName(Cell)
                    
                    If Not File Is Nothing Then
                        Cell.Offset(0, 2) = Now()
                        Set Folder = .Namespace(" ")
                        Folder.CopyHere File.Path
                    End If
                End If
            Next Cell
            
        End With


End Sub
 

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
578
Office Version
2016
Platform
MacOS
Thank you for the reply Leith,

I have added the module to my workbook and currently I am getting an error on the line

Run-Time Error 91
"Object variable or with block not set"

Folder = .Namespace(Cell.Offset(0, 1))

Any Idea what is causing the issue?
 

Leith Ross

Well-known Member
Joined
Mar 17, 2008
Messages
1,869
Office Version
2010, 2007
Platform
Windows
Hello Johnny,

Sorry, that is my fault. I did not proof read my code closely enough. There should be a Set statement before Folder. Here is the corrected macro...

Rich (BB code):
Sub SaveCopies()


    Dim Cell    As Range
    Dim File    As Object
    Dim Folder  As Variant
    Dim Rng     As Range
    Dim RngEnd  As Range
    Dim Wks     As Worksheet
    
        Set Wks = ActiveSheet
        
        Set Rng = Wks.Range("A2")
        Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
        
        If RngEnd.Row < Rng.Row Then Exit Sub Else Set Rng = Wks.Range(Rng, RngEnd)
        
        With CreateObject("Shell.Application")
            For Each Cell In Rng
                If Cell.Offset(0, 2) = Empty Then
                    Set Folder = .Namespace(Cell.Offset(0, 1))
            
                    Set File = Folder.ParseName(Cell)
                    
                    If Not File Is Nothing Then
                        Cell.Offset(0, 2) = Now()
                        Set Folder = .Namespace("C:\Users\JThunder\Downloaded Files")
                        Folder.CopyHere File.Path
                    End If
                End If
            Next Cell
            
        End With


End Sub
 
Last edited:

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
578
Office Version
2016
Platform
MacOS
Ok, now were getting somewhere!

Thanks again for all the help on this Leith.

Now, a new line is throwing an error line: Set File = Folder.ParseName(Cell)

After doing some quick research, I think I know the reason but I might be wrong. the .Parsename(Cell) does not include a file extension so I think thats why it is throwing an error. Most of the files are ".xls" but I have 2 that are ".xlsm" is there a way to add the extension to that line? Something like a ".xls*" ?
 

Leith Ross

Well-known Member
Joined
Mar 17, 2008
Messages
1,869
Office Version
2010, 2007
Platform
Windows
Hello Johhny,

This should fix the problem with the file extensions...

Rich (BB code):
Sub SaveCopies()


    Dim Cell    As Range
    Dim File    As Variant
    Dim Folder  As Object
    Dim Rng     As Range
    Dim RngEnd  As Range
    Dim Wks     As Worksheet
    
        Set Wks = ActiveSheet
        
        Set Rng = Wks.Range("A2")
        Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
        
        If RngEnd.Row < Rng.Row Then Exit Sub Else Set Rng = Wks.Range(Rng, RngEnd)
        
        With CreateObject("Shell.Application")
            For Each Cell In Rng
                If Cell.Offset(0, 2) = Empty Then
                    Set Folder = .Namespace(Cell.Offset(0, 1))
            
                    ' // Return the file name with the extension.
                    File = Dir(Folder.self.Path & "\" & Cell)
                    
                    ' // Check the file exists.
                    If File <> "" Then
                        File = Folder.self.Path & "\" & File
                        Cell.Offset(0, 2) = Now()
                        Set Folder = .Namespace(""C:\Users\JThunder\Downloaded Files"")
                        Folder.CopyHere File
                    End If
                End If
            Next Cell
            
        End With


End Sub
 

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
578
Office Version
2016
Platform
MacOS
Leith,

Thanks for the fix.

I am now getting a Compile Error "Object Required" on the line below,

Set File = Dir(Folder.self.Path & "" & Cell) also, I added in the "Set" to this row since it was missing on your last revision. I feel like were so close to completing this project!

Thanks again for all the help.
 

Leith Ross

Well-known Member
Joined
Mar 17, 2008
Messages
1,869
Office Version
2010, 2007
Platform
Windows
Hello Johhny,

I forgot to add the wild card to the cell value. I did that in my test but did not edit my code correctly again.

Change this line...
Code:
                    ' // Return the file name with the extension.
                    File = Dir(Folder.self.Path & "\" & Cell )
To this...
Code:
                    ' // Return the file name with the extension.
                    File = Dir(Folder.self.Path & "\" & Cell & "*")
 

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
578
Office Version
2016
Platform
MacOS
Good Morning Leith.

Just wanted to say thank you again for all the help on this project.

So I ran with your revised line from yesterday and I am still getting the same error message.

"Runtime Error 91: Object Variable or with block not set"

So I update your line to: by adding the "Set" to the beginning of File and a new error appears.

Compile Error: Object Required and the text Dir is being highlighted to the code below. Any ideas why its not finding an object? It seems like you have written the If statements well enough that if a file does not exist it will move on the the next search...

Rich (BB code):
' // Return the file name with the extension.
                   Set File = Dir(Folder.self.Path & "" & Cell & "*")
 
Last edited:

Leith Ross

Well-known Member
Joined
Mar 17, 2008
Messages
1,869
Office Version
2010, 2007
Platform
Windows
Hello Juhnny,

The Set statement is not used on this line because the Dir function returns a string, not an Object. You left out the backslash (reverse solidus) when you retyped the line.

The line should be...
Code:
' // Return the file name with the extension.
File = Dir(Folder.self.Path & "\" & Cell & "*")
Notice the asterisk added to the end of Cell. This is the wildcard to match all characters after the file name.
 

Forum statistics

Threads
1,082,276
Messages
5,364,196
Members
400,786
Latest member
ismi88

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top