[xpost]
[/xpost]
Hi All,
crossposted: https://www.mrexcel.com/board/…ber-uin-in-excel.1151730/
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.
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