How To Copy All Files From One Folder To Another Based On A List of Unique Identification Number (UIN) in Excel ?

kychong79

New Member
Joined
Nov 21, 2020
Messages
8
Office Version
  1. 2019
Platform
  1. Windows
Hi All,

I have multiple files with different national ID numbers under the source folder, most of the multiple files are named under the same national ID number with additional descriptive text example s12345678B_forms, s12345678B_resume_work permit, licence_s12345678B. Anyone knows the code to copy all the files associate with the national id numbers? I would appreciate any kind souls that would be able to help me with the code on this.

VBA Code:
Dim blNotFirstIteration As Boolean
Dim Fil As File
Dim hFolder As Folder, SubFolder As Folder
Dim NameOfFile As String
Dim FSO As Scripting.FileSystemObject

Sub copyfiles()
'Updateby JHey
    Dim xRg As Range, xCell As Range
    Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
    Dim xSPathStr As Variant, xDPathStr As Variant
    Dim xVal As String
    On Error Resume Next
    Set xRg = Application.InputBox("Please select the file names:", "ID", ActiveWindow.RangeSelection.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xSFileDlg.Title = "Please select the original folder:"
    If xSFileDlg.Show <> -1 Then Exit Sub
    xSPathStr = xSFileDlg.SelectedItems.Item(1) & ""
    Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xDFileDlg.Title = "Please select the destination folder:"
    If xDFileDlg.Show <> -1 Then Exit Sub
    xDPathStr = xDFileDlg.SelectedItems.Item(1) & ""
    For Each xCell In xRg
    blNotFirstIteration = False
        NameOfFile = ""
        xVal = xCell.Value
        If TypeName(xVal) = "String" And xVal <> "" Then
       FindFilesInFolders xSPathStr, xVal
            If NameOfFile <> "" Then
                FileCopy Fil.Path, xDPathStr & "\" & NameOfFile
         End If
        End If
    Next
End Sub

Sub FindFilesInFolders(ByVal HostFolder As String, FileName As String)
    If NameOfFile <> "" Then Exit Sub

    If FSO Is Nothing Then Set FSO = New Scripting.FileSystemObject
    Set hFolder = FSO.GetFolder(HostFolder)

    ' iterate through all files in the root of the main folder
    If Not blNotFirstIteration Then
      For Each Fil In hFolder.Files
          If InStr(1, FSO.GetFileName(Fil.Path), FileName) > 0 Then
              NameOfFile = FSO.GetFileName(Fil.Path)
              Exit Sub
          End If
      Next Fil
   
      ' make recursive call, if main folder contains subfolder
      If Not hFolder.SubFolders Is Nothing Then
          blNotFirstIteration = True
          Call FindFilesInFolders(HostFolder, FileName)
          If NameOfFile <> "" Then Exit Sub
      End If
   
    ' iterate through all files in all the subfolders of the main folder
    Else
      For Each SubFolder In hFolder.SubFolders
            For Each Fil In SubFolder.Files
                If InStr(1, FSO.GetFileName(Fil.Path), FileName) > 0 Then
                     NameOfFile = FSO.GetFileName(Fil.Path)
                     Exit Sub
                 End If
          Next Fil
   
          ' make recursive call, if subfolder contains subfolders
          If Not SubFolder.SubFolders Is Nothing Then
              Call FindFilesInFolders(HostFolder & "\" & SubFolder.Name, FileName)
              If NameOfFile <> "" Then Exit Sub
          End If
      Next SubFolder
    End If
    blNotFirstIteration = False
End Sub
 
Last edited by a moderator:

kychong79

New Member
Joined
Nov 21, 2020
Messages
8
Office Version
  1. 2019
Platform
  1. Windows
Hello kychong79,
I have something. Hope so that will be useful.
VBA Code:
Option Explicit

Dim varParametar, varLocation, varLocation2 As String
Dim varNLoop  As Long
Dim varFile, varArray As Variant
Dim varI As Integer
Dim varFSO, varOFile, varOFolder, varOFiles As Object

 
Sub CopyByID()

    varParametar = Application.InputBox _
         ("Insert file parameter that you are want to be copied to the new location.")
    MsgBox ("Select location where you want to move specific files.")
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
           varLocation2 = .SelectedItems(1)
        Else
            MsgBox ("Insert final destination folder.")
            Exit Sub
        End If
    End With
    MsgBox ("Select location from which you want to get specific files.")
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            varLocation = .SelectedItems(1)
            varFile = listfiles(varLocation & "\")
            For varNLoop = 1 To varI - 1
                Dim varIsParametar
                varIsParametar = InStr(1, varArray(varNLoop), varParametar)
                If varIsParametar > 0 Then
                    varFSO.CopyFile varLocation & "\" & varArray(varNLoop), varLocation2 & "\"
                End If
            Next
        End If
    End With

End Sub


Function listfiles(ByVal sPath As String)

    Set varFSO = VBA.CreateObject("Scripting.FileSystemObject")
    Set varOFolder = varFSO.GetFolder(sPath)
    Set varOFiles = varOFolder.Files
    If varOFiles.Count = 0 Then Exit Function
    ReDim varArray(1 To varOFiles.Count)
    varI = 1
    For Each varOFile In varOFiles
        varArray(varI) = varOFile.Name
        varI = varI + 1
    Next
   
End Function
Hi Max, actually i just need the code to copy all the files in the source folder based on the IDs numbers in the excel cells to another folder. As long the ID nos matches the file name that contains the ID number, it will copy the files to another folder. The previous code work fine, just that it capture 1 singular record while i had 30. I wont be able to list the file names in the range cells as the files are not named in standard naming convention. the only unique number in the file names are the IDs nos.
 

Some videos you may like

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

kychong79

New Member
Joined
Nov 21, 2020
Messages
8
Office Version
  1. 2019
Platform
  1. Windows
To copy all the files in the source folder based on the employee id ignoring the descriptive texts.


eg, Excel Sheet
Column A (Employee No)
1234
5678
4567
9000


Source Folder (File Name)
1234_payslip
work permit_1234
licence_1234_driving
5678_payslip
resume_5678
application_5678_form
4567_payslip
work permit_4567
licence_4567_driving
9000_payslip
resume_9000
application_9000_form
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,317
Office Version
  1. 365
Platform
  1. Windows
Cross posted How To Copy All Files From One Folder To Another Based On A List of Unique Identification Number (UIN) listing in Excel ? - OzGrid Free Excel/VBA Help Forum

While we do allow Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules). This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered elsewhere.
 

EXCEL MAX

Active Member
Joined
Nov 11, 2020
Messages
307
Office Version
  1. 2007
Platform
  1. Windows
I have done some modification.
Check now.
VBA Code:
Option Explicit

Dim varLocation1, varLocation2 As String
Dim varNRows, varNLoop As Long
Dim varRange1, varRange2 As Range
Dim varFile, varArray As Variant
Dim varI As Integer
Dim varFSO, varOFile, varOFolder, varOFiles As Object
Dim varIsParametar

Sub CopyByID()

    MsgBox ("Select location from where you want to move specific files.")
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
           varLocation1 = .SelectedItems(1)
        Else
            MsgBox ("Select location from where you want to move specific files.")
            Exit Sub
        End If
    End With
    MsgBox ("Select location where you want to move specific files.")
DESTINATION:
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
           varLocation2 = .SelectedItems(1)
        Else
            MsgBox ("Select location where you want to move specific files.")
            GoTo DESTINATION
        End If
    End With
    varNRows = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    varFile = varListFiles(varLocation1 & "\")
    Set varRange2 = ActiveSheet.Range("A1:A" & varNRows)
    For Each varRange1 In varRange2
        For varNLoop = 1 To varI - 1
            varIsParametar = InStr(1, varArray(varNLoop), varRange1.Value)
            If varIsParametar > 0 And Not varRange1.Value = "" Then
                varFSO.CopyFile varLocation1 & "\" & varArray(varNLoop), varLocation2 & "\"
            End If
        Next
    Next varRange1
    Set varFSO = Nothing

End Sub

Function varListFiles(ByVal varPath As String)

    Set varFSO = VBA.CreateObject("Scripting.FileSystemObject")
    Set varOFolder = varFSO.GetFolder(varPath)
    Set varOFiles = varOFolder.Files
    If varOFiles.Count = 0 Then Exit Function
    ReDim varArray(1 To varOFiles.Count)
    varI = 1
    For Each varOFile In varOFiles
        varArray(varI) = varOFile.Name
        varI = varI + 1
    Next

End Function
 

kychong79

New Member
Joined
Nov 21, 2020
Messages
8
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

I have done some modification.
Check now.
VBA Code:
Option Explicit

Dim varLocation1, varLocation2 As String
Dim varNRows, varNLoop As Long
Dim varRange1, varRange2 As Range
Dim varFile, varArray As Variant
Dim varI As Integer
Dim varFSO, varOFile, varOFolder, varOFiles As Object
Dim varIsParametar

Sub CopyByID()

    MsgBox ("Select location from where you want to move specific files.")
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
           varLocation1 = .SelectedItems(1)
        Else
            MsgBox ("Select location from where you want to move specific files.")
            Exit Sub
        End If
    End With
    MsgBox ("Select location where you want to move specific files.")
DESTINATION:
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
           varLocation2 = .SelectedItems(1)
        Else
            MsgBox ("Select location where you want to move specific files.")
            GoTo DESTINATION
        End If
    End With
    varNRows = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    varFile = varListFiles(varLocation1 & "\")
    Set varRange2 = ActiveSheet.Range("A1:A" & varNRows)
    For Each varRange1 In varRange2
        For varNLoop = 1 To varI - 1
            varIsParametar = InStr(1, varArray(varNLoop), varRange1.Value)
            If varIsParametar > 0 And Not varRange1.Value = "" Then
                varFSO.CopyFile varLocation1 & "\" & varArray(varNLoop), varLocation2 & "\"
            End If
        Next
    Next varRange1
    Set varFSO = Nothing

End Sub

Function varListFiles(ByVal varPath As String)

    Set varFSO = VBA.CreateObject("Scripting.FileSystemObject")
    Set varOFolder = varFSO.GetFolder(varPath)
    Set varOFiles = varOFolder.Files
    If varOFiles.Count = 0 Then Exit Function
    ReDim varArray(1 To varOFiles.Count)
    varI = 1
    For Each varOFile In varOFiles
        varArray(varI) = varOFile.Name
        varI = varI + 1
    Next

End Function
Hi Max, perfecto! it works flawlessly. Marvelous piece of code. appreciate your time and effort to help with my request. :) Thanks for being so unselfishly helpful.
 

EXCEL MAX

Active Member
Joined
Nov 11, 2020
Messages
307
Office Version
  1. 2007
Platform
  1. Windows
Thanks to you for your faith.
Just, next time try to describe problem slightly better.
Image, table or something like post 12.
Ok?
 

mapbv

New Member
Joined
Feb 7, 2018
Messages
3
Thanks to you for your faith.
Just, next time try to describe problem slightly better.
Image, table or something like post 12.
Ok?
Hi MAX

I find myself in the same situation, only I have a parent folder in which I have several subfolders (grouped by families) in which the interested files are found.
E.g:
P/N 3024589
is located in the parent folder in the "302" subfolder directly, or in another "drawings" subfolder of "302" folder,
another example may be
P/N XE09002345
is found in the parent folder in the "XE09" subfolder directly, or in another one, under the "drawings" subfolder of "XE09", in the form of file named like E09002345 (yes, without the X in front and possibly with several files that may have the suffixes detailed below).
But there are also unique P/Ns with other form (see the example of file source at the end, the last 2 ROW ), that can be found anywhere in the subfolders of the parent folder, without any apparent logic.

I tested the code provided by you and it works perfectly with my test files, as long as they are all directly in the source folder and not in subfolders! (I don't tested all possible forms)
The files can have in their name, P/N & SUFIX&.EXT, where:
P/N is unique, (list provided be me in XXX column)
The suffix can be ("_1"," _2"," [1]"," [2]"," (A)"," _Copy", ....), and
EXT can be (.pdf, .tiff, .doc, .....).

Can you adapt the code so that it searches the entire folder and subfolders?

OPTIONAL
1. Can you also provide a column list of possible P/N's that were not found by the automatic code? and possibly a warning message that n's P/N's were not found and that their list can be found at location "xxx" and if at least one file was found for each P/N, according to the list provided, to have a message of "OK ... blah blah blah"

2. I can also have the option to send the files that will be copied, in specific folders, which will be subfolders as part of the destination folder that will also be created by the code and have the source of the names in the right column of the P/N list, for each P/N separately?
If the column with the supposed folder names is not populated at all, the destination of the files should be the parent destination folder directly.

E.g

P/N Subfolder's
3024589 CN-MC01.s 'this folder need to be created by vba cod like subfolder as parent destination folder.
3024416 CN-MC01.s 'this folder need to be created by vba cod like subfolder as parent destination folder.
3011266 CN-MC01.s 'this folder need to be created by vba cod like subfolder as parent destination folder.
3034620 CN-F02 'this folder need to be created by vba cod like subfolder as parent destination folder.
3034229 CN-F02 'this folder need to be created by vba cod like subfolder as parent destination folder.
3038935 CN-F02 'this folder need to be created by vba cod like subfolder as parent destination folder.
XE0900477 CN-F02 'this folder need to be created by vba cod like subfolder as parent destination folder.
XE0802345 CN-F01 'this folder need to be created by vba cod like subfolder as parent destination folder.
XE0800045 'in this case the file | files matched by the cod, need to be copied directly in to parent destination folder.
3000901 'in this case the file | files matched by the cod, need to be copied directly in to parent destination folder.


example of file source:

....\Codifica\XE09\DISEGNI\E0901034_1.pdf
....\Codifica\XE09\DISEGNI\E0901034_2.pdf
....\Codifica\XE09\DISEGNI\E0901128 (2).pdf
....\Codifica\XE09\DISEGNI\E0901216_1.pdf
....\Codifica\XE09\DISEGNI\E0901217.PDF
....\Codifica\XE09\DISEGNI\E0901255.pdf
....\Codifica\XE09\DISEGNI\E0901256_1.PDF
....\Codifica\XE09\DISEGNI\E0901256_2.pdf
....\Codifica\XE09\DISEGNI\E0901257.PDF
....\Codifica\XE09\DISEGNI\E0901258_1.PDF
....\Codifica\XE09\DISEGNI\E0901258_2.PDF
....\Codifica\XE09\DISEGNI\E0901258_3.pdf
....\Codifica\XE09\DISEGNI\E0901258_4.pdf
....\Codifica\XE09\DISEGNI\E0901259.pdf
....\Codifica\303\DISEGNI\3034620_1.pdf
....\Codifica\303\DISEGNI\3034620_2.doc
....\Codifica\303\DISEGNI\3034620_3.tiff
....\Codifica\XE09\DISEGNI\E0901261.PDF
....\Codifica\XE09\DISEGNI\E0901262.PDF
....\Codifica\XE09\DISEGNI\E0901264.pdf
....\Codifica\XE09\DISEGNI\E0901265_1.pdf
....\Codifica\XE09\DISEGNI\E0901265_2.pdf
....\Codifica\XE09\DISEGNI\E0901265_3.PDF
....\Codifica\XE09\DISEGNI\E0902583[1].pdf
....\Codifica\30.07\DISEGNI\30.07.10660_A.pdf
....\Codifica\32\DISEGNI\32.0386.0000_A.pdf
.
.
.
34078 ROW's of exploded parent folder (if this information is useful to you )

I am open to any request that can make your work easier! I can provide the lists in different forms, not necessarily as I said.

Sorry for the long post but I wanted to be as specific as possible.
Thank you in advance and a wonderful Christmas to all!
 

Watch MrExcel Video

Forum statistics

Threads
1,123,380
Messages
5,601,285
Members
414,440
Latest member
Kim0204

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top