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

[Johnny Thunder]

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
	A	B	C
1	File Name	Sub Folder Directory	Saved Down as of:
2	TBT v7.5 - Australia	C:\Users\JThunder\International Reporting Package Documents\Australia	8/29/2018 9:11
3	TBT v7.5 - Brazil	C:\Users\JThunder\International Reporting Package Documents\Brazil
4	TBT v7.5 - Canada	C:\Users\JThunder\International Reporting Package Documents\Canada
5	TBT v7.5 - Canada Games	C:\Users\JThunder\International Reporting Package Documents\Canada Games
6	TBT v7.5 - Canada NL	C:\Users\JThunder\International Reporting Package Documents\Canada NL
7	TBT v7.5 - China	C:\Users\JThunder\International Reporting Package Documents\China
8	TBT v7.5 - France	C:\Users\JThunder\International Reporting Package Documents\France
9	TBT v7.5 - Germany & Austria	C:\Users\JThunder\International Reporting Package Documents\Germany & Austria
10	TBT v7.5 - Hong Kong	C:\Users\JThunder\International Reporting Package Documents\Hong Kong	8/27/2018 11:11
11	TBT v7.5 - India	C:\Users\JThunder\International Reporting Package Documents\India
12	TBT v7.5 - Italy	C:\Users\JThunder\International Reporting Package Documents\Italy
13	TBT v7.5 - Japan	C:\Users\JThunder\International Reporting Package Documents\Japan
14	TBT v7.5 - Korea	C:\Users\JThunder\International Reporting Package Documents\Korea	8/29/2018 12:11
15	TBT v7.5 - Norway	C:\Users\JThunder\International Reporting Package Documents\Norway
16	TBT v7.5 - Philippines	C:\Users\JThunder\International Reporting Package Documents\Philippines
17	TBT v7.5 - Poland	C:\Users\JThunder\International Reporting Package Documents\Poland
18	TBT v7.5 - Singapore	C:\Users\JThunder\International Reporting Package Documents\Singapore
19	TBT v7.5 - Spain & Portugal	C:\Users\JThunder\International Reporting Package Documents\Spain & Portugal
20	TBT v7.5 - Sweden	C:\Users\JThunder\International Reporting Package Documents\Sweden
21	TBT v7.5 - Switzerland	C:\Users\JThunder\International Reporting Package Documents\Switzerland
22	TBT v7.5 - Taiwan	C:\Users\JThunder\International Reporting Package Documents\Taiwan
23	TBT v7.5 - Thailand	C:\Users\JThunder\International Reporting Package Documents\Thailand
24	TBT v7.5 - Turkey	C:\Users\JThunder\International Reporting Package Documents\Turkey
25	TBT v7.5 - United Kingdom	C:\Users\JThunder\International Reporting Package Documents\United Kingdom
26	TBT v7.5 - UK Productions	C:\Users\JThunder\International Reporting Package Documents\UK Productions
27	TBT v7.5 - WBTT Games	C:\Users\JThunder\International Reporting Package Documents\WBTT Games
28	TBT v7.5 - WHV (UK)	C:\Users\JThunder\International Reporting Package Documents\WHV (UK)
Sheet1

 

[Leith Ross]

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.

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]

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]

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...

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

 

[Johnny Thunder]

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]

Hello Johhny,

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

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]

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]

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...

                    ' // Return the file name with the extension.
                    File = Dir(Folder.self.Path & "\" & Cell )

To this...

                    ' // Return the file name with the extension.
                    File = Dir(Folder.self.Path & "\" & Cell & "*")

 

[Johnny Thunder]

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...

' // Return the file name with the extension.
                   Set File = Dir(Folder.self.Path & "" & Cell & "*")

 

[Leith Ross]

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...

' // 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.