Hello, I have this code that will take a list of Part Numbers (in column A) search a folder where they are located and copy them into another folder. However, it is not copying the exact list from column A. Example: PN listed in column A might be 12345, the code might bring back 12345-1 instead of the 12345 as listed. I need the exact reference list.
PLEASE HELP
PLEASE HELP
Code:
Sub QIPProcess()
'You can use this to delete all xl? files in the folder Test
On Error Resume Next
Kill "\\us108fp00\data\Krshare\QIP conversions\PrintQIPTempFile\*.xl*"
On Error GoTo 0
'*************************************************************
'****** Change these 2 Const values to match with your
'****** worksheet layout for the list of filenames on it
'put the column letter that your list is in as this Const
Const listColumn = "A"
'put the first row that a file is listed in as this Const
Const firstFileRow = 2 ' assumes a label in row 1
'*************************************************************
Dim sourcePath As String
Dim destPath As String
Dim listOfSourceFiles As Range
Dim anySourceFile As Range
'dictionary object to get list of files in source folder initially
Dim allFiles As Object
'will be an array with contents of allFiles in it
'so we can reference them for use
Dim filesInFolder As Variant
Dim arrayElement As Variant
Dim lastRow As Long
Dim anyFileName As String
Dim copiedCount As Long
'check if there any files listed on the active sheet
lastRow = Range(listColumn & Rows.Count).End(xlUp).Row
If lastRow < firstFileRow Or _
IsEmpty(Range(listColumn & lastRow)) Then
MsgBox "There are no files listed to be copied on the active sheet.", _
vbOKOnly + vbExclamation, "No Files to Copy"
Exit Sub
End If
sourcePath = BrowseFolderDialog("Select the Folder with all files in it")
If sourcePath = vbNullString Then
MsgBox "No source folder selected. Quitting.", _
vbOKOnly + vbExclamation, "No Source Folder Chosen"
Exit Sub
Else
sourcePath = sourcePath & Application.PathSeparator
End If
destPath = BrowseFolderDialog("Now select the Folder to copy files into")
If destPath = vbNullString Then
MsgBox "No destination folder selected. Quitting.", _
vbOKOnly + vbExclamation, "No Destination Folder Chosen"
Exit Sub
Else
destPath = destPath & Application.PathSeparator
End If
'set reference to the list of files to be copied.
Set listOfSourceFiles = Range(listColumn & firstFileRow & ":" _
& listColumn & lastRow)
'build list of files in the source folder that can be
'searched very rapidly when we need to
Set allFiles = CreateObject("Scripting.dictionary")
anyFileName = Dir$(sourcePath & "*.*")
Do While anyFileName <> ""
DoEvents ' let system do background tasks
If Not allFiles.Exists(anyFileName) Then
allFiles.Add anyFileName, 1
End If
anyFileName = Dir$()
Loop
'extract file names into variant array
filesInFolder = allFiles.keys
'empty out the dictionary object just to recover memory
allFiles.RemoveAll
'work through the list of files to be copied
For Each anySourceFile In listOfSourceFiles
DoEvents ' let system do background tasks
'work through each filename in array filesInFolder
'make sure there is a filename to look for
If Not IsEmpty(anySourceFile) Then
For Each arrayElement In filesInFolder
'if the file in the source folder starts
'with the filename from the worksheet
'then copy that file to the destination folder
If InStr(arrayElement, anySourceFile) = 1 Then
FileCopy sourcePath & arrayElement, destPath & arrayElement
copiedCount = copiedCount + 1
'done here, no need to look for more matches
Exit For ' exit arrayElement loop
End If
Next ' end arrayElement loop
End If
Next ' end anySourceFile loop
'housekeeping cleanup: makes sure all RAM assigned released back to system
Erase filesInFolder
Set allFiles = Nothing
Set listOfSourceFiles = Nothing
'announce job done
MsgBox copiedCount & " Files were copied.", _
vbOKOnly + vbInformation, "Task Completed"
End Sub
