+ Reply to Thread
Results 1 to 2 of 2

Search and Copy from file list within subfolders to one destination folder VBA Script

  1. #1
    Registered User
    Join Date
    09-15-2016
    Location
    CANADA
    MS-Off Ver
    2007
    Posts
    3

    Exclamation Search and Copy from file list within subfolders to one destination folder VBA Script

    After hours of searching I am totally exhausted....hopefully I articulate my situation for some assistance.
    Looking for a VBA code to do the following...found lots of examples that address a couple of aspects of what I am trying to accomplish, however cannot tie them all together...ok lets go lol

    I have a list of file names in column A 123.pdf or 123.xls So on and so forth (it doesnt matter)

    I would like the code to search a number of sub folders off the root folder for those files (in column A) and when found copy them to a folder I designate

    I found this code i altered that works perfect however only works at the root and does not search within the sub folders...

    Sub SEARCH_COPY_FILES()
    Dim r As Range
    Dim SourcePath As String, DestPath As String, FName As String
    'Setup source and dest path (Note: must have a trailing backslash!)
    SourcePath = "**************\"
    DestPath = "****************\"
    'Visit each used cell in column A
    For Each r In Range("A1", Range("A" & Rows.Count).End(xlUp))
    'Search the file with the file mask from the cell (Note: can contain wildcards like *.xls)
    FName = Dir(SourcePath & r)
    'Loop while files found
    Do While FName <> ""
    'Copy the file
    FileCopy SourcePath & FName, DestPath & FName
    'Search the next file
    FName = Dir()
    Loop
    Next
    End Sub


    ***then found this code which does search the subs however only for one file or type of file (*.pdf) which again works...

    Sub CopyFiles()
    Dim iRow As Integer ' ROW COUNTER.
    Dim sSourcePath As String
    Dim sDestinationPath As String
    Dim sFileType As String

    Dim bContinue As Boolean

    bContinue = True
    iRow = 2

    ' THE SOURCE AND DESTINATION FOLDER WITH PATH.
    sSourcePath = "\\*********************\"
    sDestinationPath = "\\******************\"

    sFileType = "" ' TRY WITH OTHER FILE TYPES LIKE ".pdf".

    ' LOOP THROUGH COLUMN "B" TO PICK THE FILES.
    While bContinue

    If Len(Range("A" & CStr(iRow)).Value) = 0 Then ' DO NOTHING IF THE COLUMN IS BLANK.
    MsgBox "Process executed" ' DONE.
    bContinue = False
    Else
    ' CHECK IF FILES EXISTS.

    If Len(Dir(sSourcePath & Range("A" & CStr(iRow)).Value & sFileType)) = 0 Then
    Range("C" & CStr(iRow)).Value = "Does Not Exists"
    Range("C" & CStr(iRow)).Font.Bold = True
    Else
    Range("C" & CStr(iRow)).Value = "COPIED"
    Range("C" & CStr(iRow)).Font.Bold = False

    If Trim(sDestinationPath) <> "" Then
    Dim objFSO
    Set objFSO = CreateObject("scripting.filesystemobject")

    ' CHECK IF DESTINATION FOLDER EXISTS.
    If objFSO.FolderExists(sDestinationPath) = False Then
    MsgBox sDestinationPath & " Does Not Exists"
    Exit Sub
    End If

    '*****
    ' HERE I HAVE INCLUDED TWO DIFFERENT METHODS.
    ' I HAVE COMMENTED THE SECOND METHOD. TO THE SEE THE RESULT OF THE
    ' SECOND METHOD, UNCOMMENT IT AND COMMENT THE FIRST METHOD.

    ' METHOD 1) - USING "CopyFile" METHOD TO COPY THE FILES.
    objFSO.CopyFile Source:=sSourcePath & Range("A" & CStr(iRow)).Value & _
    sFileType, Destination:=sDestinationPath

    ' METHOD 2) - USING "MoveFile" METHOD TO PERMANENTLY MOVE THE FILES.
    'objFSO.MoveFile Source:=sSourcePath & Range("B" & CStr(iRow)).Value & _
    sFileType, Destination:=sDestinationPath
    '*****
    End If
    End If
    End If

    iRow = iRow + 1 ' INCREMENT ROW COUNTER.
    Wend
    End Sub

    I surrender...please someone out there help me out with this...I am sure it is something simple and hope that I explained my predicament.
    Vicco

  2. #2
    Forum Contributor arlu1201's Avatar
    Join Date
    09-09-2011
    Location
    Bangalore, India
    MS-Off Ver
    Excel 2003 & 2007
    Posts
    19,166
    Hello VICCO12,

    Welcome to Excelforum. Be a part of large Excel community. Enjoy Learning.
    If I have helped, Don't forget to add to my reputation (click on the star below the post)
    Don't forget to mark threads as "Solved" (Thread Tools->Mark thread as Solved)
    Use code tags when posting your VBA code: [code] Your code here [/code]

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. [SOLVED] list of subfolders in folder - without files and sub-subfolders
    By MartyZ in forum Excel Programming / VBA / Macros
    Replies: 4
    Last Post: 06-11-2022, 10:56 AM
  2. Replies: 0
    Last Post: 04-21-2014, 04:03 PM
  3. [SOLVED] Macro to create hyperlink list of every file in a folder, subfolders
    By itmanusa in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 09-25-2013, 12:43 PM
  4. Macro to create hyperlink list of every file in a folder, subfolders, and SHORTCUTS
    By Billdick7788 in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 09-20-2013, 11:11 AM
  5. how to search a file in folder and subfolders
    By rakeshredround in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 09-05-2012, 03:35 AM
  6. Macro to search folder including subfolders for file and open
    By kiraexiled in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 09-01-2012, 02:45 PM
  7. Replies: 2
    Last Post: 03-26-2012, 07:12 PM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1