VBA code to Copy File Based on Keywords in File Name

[Parth13]

Hi,
I am trying to write a code which will copy files from one directory to other based on some keywords in File Name.
The keywords are specified in a range in the spreadsheet. The code should pick each keyword, search for files containing that keyword and copy all the files with that keyword in the name to the directory specified. If the keyword is not found, it highlights the cell in the range as red.
Here's the Code:

Sub CopyFiles()
Dim srcFOLDER As String
Dim tgtFOLDER As String
Dim fRNG      As Range
Dim fName     As Range
Dim BAD       As Boolean
srcFOLDER = ActiveSheet.Cells(4, 3)
tgtFOLDER = ActiveSheet.Cells(5, 3)   
 
Set fRNG = ActiveSheet.Range("E4:E2000").SpecialCells(xlConstants)
For Each fName In fRNG
If InStr(1, Dir(srcFOLDER), fName, vbTextCompare) Then 'Checking whether the file contain keywords in column
    
FileCopy srcFOLDER & "*" & fName & "*" & .Text, tgtFOLDER & "*" & fName & "*" & .Text 
 
Else
        fName.Interior.ColorIndex = 3
        BAD = True
    End If
Next fName
    
If BAD Then MsgBox "Some files were not found. These were highlighted for your reference."
End Sub

It works fine till it reaches copying section where I am getting error "Bad file name" or "Invalid Qualifier". If anyone could help correcting this one. Thanks.

 

[kbriaz]

Hello,

Amazing coding skills. I slightly modified the below code which works flawlessly;

sFilename = Dir(sSrcFolder & c.Text & "*" & "D Letter" & "*")

however, when i try

sFilename = Dir(sSrcFolder & c.Text & "*" & "D Letter" Or "C Letter" & "*")

I get type mis-match error, because file path can't contain logical operator ?

how can i get around this ?

My file name at some point will contain 'd letter' or 'c letter'. Any help will be appreciated - ta

 

[Jerry Sullivan]

Hi kbriaz,

It looks like you've used the code in Post #4 as your starting point.

An easy but potentially faulty tweak to copy all the files that have either pattern:
sSrcFolder & c.Text & "*" & "C Letter" & "*" or
sSrcFolder & c.Text & "*" & "D Letter" & "*"

would be to use the pattern:

Dir(sSrcFolder & c.Text & "*" & "[B][COLOR="#0000CD"]?[/COLOR][/B] Letter" & "*")

That would copy all the files you want, however it would also copy any files that match the pattern using other characters like "A Letter" or "B Letter"

Below is a modified version of the code in Post #4 that should do what you want...

Sub CopyFiles_ContainingParts()
 Dim lNdx As Long
 Dim sSrcFolder As String, sTgtFolder As String, sFilename As String
 Dim c As Range, rPatterns As Range
 Dim bBad As Boolean, bFound As Boolean
 Dim vParts As Variant
 
 '--each of these parts will be tried in the pattern search
 vParts = Array("C Letter", "D Letter")

 sSrcFolder = ActiveSheet.Cells(4, 3)
 sTgtFolder = ActiveSheet.Cells(5, 3)

 Set rPatterns = ActiveSheet.Range("E4:E2000").SpecialCells(xlConstants)
 For Each c In rPatterns
   bFound = False
   For lNdx = LBound(vParts) To UBound(vParts)
      sFilename = Dir(sSrcFolder & c.Text & "*" & vParts(lNdx) & "*")
      If Len(sFilename) Then
         While sFilename <> ""
             FileCopy sSrcFolder & sFilename, sTgtFolder & sFilename
             sFilename = Dir()
         Wend
      End If
   Next lNdx
   
   If bFound = False Then
      bBad = True
      c.Interior.ColorIndex = 3
   End If
 Next c
 If bBad Then MsgBox "Some files were not found. " & _
    "These were highlighted for your reference."
End Sub

If you had many more optional parts then it would be more efficient to use something like the code in Post #18.
That approach is to read all the files in the folder just once, then test those names against your patterns.
VBA's RegEx (Regular Expressions) can be used if you have more complex patterns.

For the simple pattern that you describe, the code in this post should handle that pretty well.

 

[kbriaz]

Many thanks Jerry for your reply.

I changed the macro slightly, but now at

Set rPatterns = ActiveSheet.Range("A2:B" & lngLast).SpecialCells(xlConstants)

i get an 'Application-defined or object-defined error' error.

Any idea what i am missing ?

Many thanks.

P.s below is the code which i am using, all thanks to you



"
Dim lngLast As Long
Dim lNdx As Long
Dim sSrcFolder As String, sTgtFolder As String, sFilename As String
Dim c As Range, rPatterns As Range
Dim bBad As Boolean, bFound As Boolean


Dim vParts As Variant

'--each of these parts will be tried in the pattern search
vParts = Array("C Letter", "D Letter")

Set rPatterns = ActiveSheet.Range("A2:B" & lngLast).SpecialCells(xlConstants)

For Each c In rPatterns

sSrcFolder = "K:\A & A\" & c.Offset(0, 1).Text & "\C\" & c.Text & "\"
sTgtFolder = "K:\London\"


bFound = False
For lNdx = LBound(vParts) To UBound(vParts)
sFilename = Dir(sSrcFolder & c.Text & "*" & vParts(lNdx) & "*")
If Len(sFilename) Then
While sFilename <> ""
FileCopy sSrcFolder & sFilename, sTgtFolder & sFilename
sFilename = Dir()
Wend
End If
Next lNdx

If bFound = False Then
bBad = True
c.Interior.ColorIndex = 3
End If
Next c
If bBad Then MsgBox "Some files were not found. " & _
"These were highlighted for your reference."
"

 

[Jerry Sullivan]

The error is because the variable lngLast hasn't been assigned a value prior to that point in the code.

If you want to find the last row of data in Column A on the ActiveSheet, you can use this statement:

lngLast = Cells(Rows.Count, "A").End(xlUp).Row

 

[kbriaz]

Many thanks Jerry. Slight problem now. Code now highlights the references even if it finds either a C letter or L Letter.

Every item in column will only have one type of letter, either a C or L letter - sorry if i didn't mention this earlier.

Code should highlights refs which do not have a 'C Letter' & 'L Letter' both.

Any idea how i can fix this ?

Again, many thanks for your time & amazing skills.

Regards

 

[Jerry Sullivan]

Whoops. I left out one line...

      If Len(sFilename) Then
         [B]bFound = True[/B]

 

[kbriaz]

Hi Jerry, sorry i was away. thanks for the code. at which point should i enter

If Len(sFilename) Then
bFound = True

Also, how can i incorporate Environ("USERNAME") in the 'sSrcFolder' ? Please

Trying to copy files based on search criteria:

From
C:\Users\Anni (Where Anni is the currently logged on user, which can change)

To
A folder created by macro, with today's date. many thanks - again

 

[Jerry Sullivan]

Here's some code you can try...

Sub CopyFiles_ContainingParts()
 Dim lngLast As Long, lNdx As Long
 Dim sSrcFolder As String, sTgtFolder As String, sFilename As String
 Dim C As Range, rPatterns As Range
 Dim bBad As Boolean, bFound As Boolean
 Dim vParts As Variant
 
 '--each of these parts will be tried in the pattern search
 vParts = Array("C Letter", "D Letter")

 sSrcFolder = ActiveSheet.Cells(4, 3)
 sTgtFolder = ActiveSheet.Cells(5, 3)

 Set rPatterns = ActiveSheet.Range("A2:B" & lngLast).SpecialCells(xlConstants)
 For Each C In rPatterns
   bFound = False

   sSrcFolder = "C:\Users\" & Environ("username") & "\"
   '--modify to reference folder created by macro, with today's date
   sTgtFolder = "K:\London\"
   For lNdx = LBound(vParts) To UBound(vParts)
      sFilename = Dir(sSrcFolder & C.Text & "*" & vParts(lNdx) & "*")
      If Len(sFilename) Then
         bFound = True
         While sFilename <> ""
             FileCopy sSrcFolder & sFilename, sTgtFolder & sFilename
             sFilename = Dir()
         Wend
      End If
   Next lNdx
   
   If bFound = False Then
      bBad = True
      C.Interior.ColorIndex = 3
   End If
 Next C
 If bBad Then MsgBox "Some files were not found. " & _
    "These were highlighted for your reference."
End Sub

It isn't clear to me whether you were asking for help with creating or referencing the target: "A folder created by macro, with today's date. "
Please clarify if you are wanting help with that.

 

[kbriaz]

Sorry for not being clear. i want macro to create a folder named (Letter) with today date at

K:\London\

Then i want it to create two more sub directories within this folder i.e

Letter - (Todays date) ---> C Letter
Letter - (Todays date) ---> D Lettter

C letters will be copied into (C letter) folder & D letters will be copied into (D letter) folder.

C letters & D letters, both directories are within (Letter) folder.

Sorry for being confusing.

 

[Jerry Sullivan]

Do you want to create those two folders even if there are no matching files to be copied to one of them?

What is the formatting of the date and please provide an example as I'm not sure whether your "---->" is to be taken literally.