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

 

[Johnny Thunder]

Leith,

Here is the code in its entirety. Unfortunately even with the last modification provided I am still getting a "Runtime Error 91: Object Variable or with block not set" on the same line?

Sub SaveCopies()
'--------------------------------------------------------
'--- Searches for TBT Files within Directory
'---------------------------------------------------------
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 & "*")  '<------------------this line is still throwing an error
                
                ' // 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

 

[Leith Ross]

Hello Johnny,

The problem seems to be that the Folder is not found. Over the years, I have seen problems on machines where the default property for a Range object, i.e. Value, does not work unless you specify it. I have made that change to the macro along with adding a error message to alert you if the folder could not be found. Hopefully, this will solve the problems you are having.

Updated Macro Code

Sub SaveCopies()


    Dim Cell    As Range
    Dim File    As Variant
    Dim Folder  As Object
    Dim ret     As Long
    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).Value = Empty Then
                    Set Folder = .Namespace(Cell.Offset(0, 1).Value)
                    
                    ' // Check that the folder exists.
                    If Folder Is Nothing Then
                        ret = MsgBox("The Folder """ & Cell.Offset(0, 1).Value & """ was Not Found." & vbLf & "Continue?", vbYesNo)
                        If ret = vbNo Then Exit Sub
                    End If
            
                    ' // Return the file name with the extension.
                    File = Dir(Folder.self.Path & "\" & Cell.Value & "*")
                    
                    ' // Check the file exists.
                    If File <> "" Then
                        File = Folder.self.Path & "\" & File
                        Cell.Offset(0, 2).Value = Now()
                        Set Folder = .Namespace("C:\Users\JThunder\Downloaded Files")
                        Folder.CopyHere File
                    End If
                End If
            Next Cell
            
        End With


End Sub

 

[Johnny Thunder]

Woohoo!

This is awesome! So it is now working much better and bringing the files. A new issues is occuring and I am hoping there is a quick fix.

So currently, the scenario I am working on; I have files within folders 1-3, then for folder 4 I intentionally left it blank with no file, your "Ret" msgbox is flagging file as missing, option Yes to continue or No to exit sub. The problem is that when I select Yes, the code dims File as the missing filename and then the code crashes. Is there a way in this scenario to have the code skip the File 4 if it does not exist and continue looping thru the list of files, so in the above scenario skip and re-run code with file 5 and so on?

Hopefully the scenario makes sense how I am explaining it.

Your help has been invaluable to me and this project.

 

[Leith Ross]

Hello Johnny,

This version will skip over any folder that does not exist with no notification.

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).Value = Empty Then
                    Set Folder = .Namespace(Cell.Offset(0, 1).Value)
                    
                    ' // Check that the folder exists.
                    If Not Folder Is Nothing Then
                        ' // Return the file name with the extension.
                        File = Dir(Folder.self.Path & "\" & Cell.Value & "*")
                    
                        ' // Check the file exists.
                        If File <> "" Then
                            File = Folder.self.Path & "\" & File
                            Cell.Offset(0, 2).Value = Now()
                            Set Folder = .Namespace("C:\Users\JThunder\Downloaded Files")
                            Folder.CopyHere File
                        End If
                    End If
            Next Cell
            
        End With


End Sub

 

[Johnny Thunder]

Hey Leith,


Thanks for all the multiple revisions. I am now getting a new error on the line Next Cell. "Compile Error: Next Without For" I tried moving things around to troubleshoot but no luck.

Hopefully this is a quick fix.

 

[Leith Ross]

Hello Johnny,

Sorry, my fault. There is a missing End If. This should work...

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).Value = Empty Then
                    Set Folder = .Namespace(Cell.Offset(0, 1).Value)
                    
                    ' // Check that the folder exists.
                    If Not Folder Is Nothing Then
                        ' // Return the file name with the extension.
                        File = Dir(Folder.self.Path & "\" & Cell.Value & "*")
                    
                        ' // Check the file exists.
                        If File <> "" Then
                            File = Folder.self.Path & "\" & File
                            Cell.Offset(0, 2).Value = Now()
                            Set Folder = .Namespace("C:\Users\JThunder\Downloaded Files")
                            Folder.CopyHere File
                        End If
                    End If
                End If
            Next Cell
            
        End With


End Sub

 

[Johnny Thunder]

Your Awesome! that was the ticket!

All working solid now! Thanks again for spending time on this!