Copy/Paste files into new folders based on condition

Hi

New to Excel VBA and was hoping someone could help.

I am trying to create a macro wherein 20 folders are created (names of folders are from the range of cells e.g. B2:B21). This seems to work OK.

I am then trying to copy 5 (different) pdf files (which are chosen according to a criteria ie. score of <=50%) into each of the 20 folders. This bit is not working properly and I think it's because the cell.Value (which contains the pdf location) is just a file path so the actual physical pdf is not being copied? Please see code below.

Can anyone help me with copying the relevant pdf files across into each of the 20 folders. Or alternative could be that all 5x20=100 pdfs are copied into 1 folder but sorted in some way so I know which pdfs belong to which candidate?

I've attached my files also. Would really appreciate any help here as I'm not sure I am doing this correctly.

Also I've commented out the shell call which I know you can use to print ... but I need copy/paste into new folders instead.

Code:

---

'CREATE INDIVIDUAL FOLDERS
On Error Resume Next
For Each cell In rng2
FldrName = cell
MkDir "C:\Users\test\Documents\Files" & FldrName
Next cell
'COPY PDF FILES IN COLUMN D TO CREATED FOLDERS
For Each cell In rng1
If cell.Offset(0, 3) <= 0.5 And count <= 5 Then
If Not dnary.Exists(cell.Value) Then
dnary.Add cell.Value, 1
FileCopy cell.Value, "C:\Users\test\Documents\Files" & FldrName
'Call apiShellExecute(Application.hwnd, "print", cell.Value, vbNullString, vbNullString, 0)count = count + 1
End If
End If
Next cell

---

Welcome to the forum!

I am not sure about some things.

1. Had to use Trim() as subfolders had space character at end.
2. Check that ActiveSheet is approriate for lastrow.
3. Look at logic for the count counter of 5.

In any case, this should get you close...

Code:

---

Sub Save_PDF_Papers_2() 
  '(ByVal fname As String)  '--------------------------------------
  'DECLARE AND SET VARIABLES
  Dim c1 As Range, c2 As Range, rng1 As Range, rng2 As Range
  Dim dnary As Object, p2 As String, count As Long
  Dim LastRow As Long, FldrName As String
 
  p2 = "C:\Users\test\Documents\"
  'p2 = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\"
 
'------------- ActiveSheet could be a problem?
  LastRow = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row
  Set rng1 = Worksheets("Main").Range("D5:D" & LastRow)
  Set rng2 = Worksheets("Candidate").Range("B2:B" & LastRow)
  Set dnary = CreateObject("Scripting.Dictionary")
  count = 0
  '--------------------------------------
Debug.Print rng2.Address
  'CREATE INDIVIDUAL FOLDERS
  If Dir(p2 & "Files\", vbDirectory) = "" Then MkDir p2 & "Files\"
  p2 = p2 & "Files\"
  For Each c2 In rng2
    If Dir(p2 & c2, vbDirectory) = "" Then MkDir p2 & c2
  Next c2


  'COPY PDF FILES IN COLUMN D TO CREATED FOLDERS
  For Each c1 In rng1
    If c1.Offset(0, 3) <= 0.5 And count <= 5 Then
      If Not dnary.Exists(c1) And Dir(c1) <> "" Then
        dnary.Add c1, 1
        For Each c2 In rng2
          FileCopy c1, p2 & Trim(c2) & "\" & Right(c1, Len(c1) - InStrRev(c1, "\"))
          'Call apiShellExecute(Application.hwnd, "print", cell.Value, vbNullString, vbNullString, 0)
          count = count + 1
        Next c2
      End If
    End If
  Next c1
'--------------------------------------




'CLEANUP
End Sub

---

Hi Ken

Thanks for your reply and help.

I am new to this so not sure why ActiveSheet would be a problem (as that's what I've picked up on my learning journey so far). Is there an alternative?

I've realised that I am using LastRow for both sheets ie. Main and Candidate. Is that what you mean when you say ActiveSheet may be a problem?

LastRow = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row
Set rng1 = Worksheets("Main").Range("D5" & LastRow)
Set rng2 = Worksheets("Candidate").Range("B2:B" & LastRow)

Each candidate only needs 5 files that's why I set the counter to 5 (with the condition of a score of "<=50%"). I have had a look and can't work out the problem here.

The code runs OK but the correct files are not being copied over. Seems to copy the 1st file which is <=50% and then copy that same file into every folder. This is despite a loop running through every candidate and checking the scores for each candidate? Could you help me here please?

To control the right number or rows, explicitly set which sheet it should come from. e.g. Worksheets("Main")

You would have to explain what governs which subfolder it should go to. #1 code looked like your intent was to copy to last subfolder since it was last in the first loop. I guessed that you wanted if criterion ws matched, put in all subfolders.

Hi Ken

Sorry if I wasn't clear in my #1 post.

Each candidate would have (up to) 5 pdf files in their (newly created) folder. The pdf files for each candidate would of course be different as they have scored differently on each topic. See Column G on the Main sheet for scores. Starting from cell D5, each file would be copied and placed in each candidate folder (up to 5 files in each folder).

Thanks for your help as I've really become a bit unstuck here but I know I was nearly there so it's a bit frustrating.

If anything else is not clear please just let me know.

Thanks again

Ok, I see what you need now. IF you want 5, then we need to set count=1 before loop. We need Trim() for C2 since it is getting the subfolder name from the other sheet which has the suffix space characters.

Code:

---

Sub Save_PDF_Papers_3() 
  '(ByVal fname As String)  '--------------------------------------
  'DECLARE AND SET VARIABLES
  Dim c1 As Range, c2 As Range, rng1 As Range, rng2 As Range
  Dim dnary As Object, p2 As String, count As Long
  Dim LastRow As Long, FldrName As String
 
  p2 = "C:\Users\test\Documents\"
  p2 = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\"
 
'------------- ActiveSheet could be a problem?
  LastRow = Worksheets("Main").Cells(Rows.count, 1).End(xlUp).Row
  Set rng1 = Worksheets("Main").Range("D5:D" & LastRow)
  Set rng2 = Worksheets("Candidate").Range("B2:B" & LastRow)
  Set dnary = CreateObject("Scripting.Dictionary")
  count = 1
  '--------------------------------------


  'CREATE INDIVIDUAL FOLDERS
  If Dir(p2 & "Files\", vbDirectory) = "" Then MkDir p2 & "Files\"
  p2 = p2 & "Files\"
  For Each c2 In rng2
    If Dir(p2 & c2, vbDirectory) = "" Then MkDir p2 & c2
  Next c2


  'COPY PDF FILES IN COLUMN D TO CREATED FOLDERS
  For Each c1 In rng1
    If c1.Offset(0, 3) <= 0.5 And count <= 5 Then
      If dnary.Exists(c1) = False And Dir(c1) <> "" Then
        dnary.Add c1, 1
          FileCopy c1, p2 & Trim(c1.Parent.[c2]) & "\" & Right(c1, Len(c1) - InStrRev(c1, "\") - 1)
          ' apiShellExecute(Application.hwnd, "print", cell.Value, vbNullString, vbNullString, 0)
          count = count + 1
      End If
    End If
  Next c1
'--------------------------------------




'CLEANUP
End Sub

---

Hi Ken

Thanks but only the 1st candidate is getting the 5 files? Also Trim is trimming e.g. 'TOPICS_01.pdf' into 'OPICS_01.pdf'

I forgot to mention that I am trying to convert the Range on the Main sheet ie. A1:H29 into a pdf and also add into the candidate folder. The range pdf would be the candidates name. Could you tell me if I would just use

Range("A1:H29").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
p2\candidateName.pdf, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

and add some of it to my loop?

Once again, thanks for all your help and I appreciate it a lot.

What is the purpose for the dictionary object? Is it to not count duplicate filenames or to do maybe 5 for one candidate but the next candidate would not use any of those?

To get the Main sheet to update, an embedded loop is used to update Main sheet's cell F1.

The pdf file creation is easily done.

Hi Ken

No, it could be the case that two (or more) candidates works on say for e.g. TOPIC2 (as they both got that topic incorrect). So each candidate would have 5 files (and they may well be the same files and in a lot of cases will be the same). The goal is for each candidate to have their own 5 files (may well be the same as another candidate).

I am now trying to save ALL the files in ONE folder (as opposed to separate folders) as I've realised that will be easier for printing. However I need the main sheet range also as a pdf so that I can sort the files and know which pdfs belong to which candidate.

Hope that makes sense and thanks again for your help and patience.

I'll work it up after lunch.

1. IF the filenames don't have duplicates, I don't see a need for the dictionary.
2. Normally, I like to fso to get the base filename, check for file or folder existence. If you use this for a mac, that would not work.

Hi Ken

No I'm not using a mac.

Sorry Ken, I am new to this so I am using code that I have learnt/taken from the web/help from people.

I am trying to get all files in ONE folder now (sorted and with the MAIN sheet as a candidate_named_pdf) so if you could help me with that I would greatly appreciate it.

I don't know what ONE folder you want them in. That would simplify things.

In any case, here is the one that copies the first 5 files with <= 0.5 and their Main pdf. It also uses FSO FWIW.

Code:

---

Sub Save_PDF_Papers_4() 
  '--------------------------------------
  'DECLARE AND SET VARIABLES
  Dim c1 As Range, c2 As Range, rng1 As Range, rng2 As Range
  Dim d As Object, p2 As String, count As Long
  Dim LastRow As Long, fn As String
  Dim wsM As Worksheet, wsC As Worksheet, i As Long
  Dim fso As Object, pf as object  'Late Binding
  'Dim fso As FileSystemObject, pf As Folder 'Early Binding
 
  p2 = "C:\Users\test\Documents\"
  'p2 = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\"
 
  'Set objects
  Set wsM = Worksheets("Main")
  Set wsC = Worksheets("Candidate")
  Set rng1 = wsM.Range("D5", wsM.Cells(Rows.count, "D").End(xlUp))
  Set rng2 = wsC.Range("B2", wsC.Cells(Rows.count, "B").End(xlUp))
  Set fso = CreateObject("Scripting.FileSystemObject")
  'Set d = CreateObject("Scripting.Dictionary")


  With fso
    'CREATE INDIVIDUAL FOLDERS
    If Not .FolderExists(p2 & "Files") Then _
      .GetFolder(p2).SubFolders.Add "Files"
    p2 = p2 & "Files\"
    Set pf = .GetFolder(p2)
    For Each c2 In rng2
      If Not .FolderExists(p2 & c2) Then pf.SubFolders.Add c2
    Next c2
 
    'Iterate each candidate reference to update Main sheet.
    For i = 1 To rng2.Rows.count
      wsM.[F1] = rng2(i).Offset(, -1) 'Reference number for candidate
      count = 1
      'Iterate each file item and copy files and make pdf for candidate.
      For Each c1 In rng1
        If c1.Offset(, 3) <= 0.5 And count <= 5 Then
          If .FileExists(c1) Then
            .CopyFile c1, p2 & Trim(wsM.[c2]) & "\" & .GetFileName(c1)
            'FileCopy c1, p2 & Trim(wsM.[c2]) & "\" & Right(c1, Len(c1) - InStrRev(c1, "\"))
            count = count + 1
          End If
        End If
      Next c1
      wsM.Range("A1:H29").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        p2 & Trim(wsM.[c2]) & "\" & Trim(wsM.[c2]) & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next i
   
  End With
'--------------------------------------


'CLEANUP
  Set pf = Nothing
  Set fso = Nothing
 
  MsgBox "All done..."
End Sub

---

Hi Ken

Thanks.

Sorry I meant one folder as opposed to individual folders. i.e. all files for all candidates are stored in a/one folder but are in sorted so it's clear which files belong to which candidate. That would make printing a lot easier.

Thanks for your help and sorry for the confusion.

Hi Ken

Thanks for the heads up with fso. Pretty neat way of doing it and I've noticed it works A LOT quicker than how I was doing it.

Could you tell me if I wanted to copy all the candidate files (for every candidate) into a folder called 'Paper' would I simply not include the code below (and instead create one folder called 'Paper'). Once again thanks for all your help - it really is appreciated.

For Each c2 In rng2
If Not .FolderExists(p2 & c2) Then pf.SubFolders.Add c2
Next c2

I don't know what you mean by candidate file. Is it the created pdf file from?

Code:

---

wsM.Range("A1:H29").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _       
  p2 & Trim(wsM.[c2]) & "\" & Trim(wsM.[c2]) & ".pdf", Quality:=xlQualityStandard, _
  IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

---

Hi Ken

Yes that's correct. However I would like ALL of the 6 files in each candidate folder (1 pdf created from the range A1:H29 and the 5 topic files) to appear in a folder called 'Paper'. So the folder called 'Paper' would probably have about 120 pdf files in it sorted, not just the 20 created pdfs (for 20 candidates) from the range A1:H29.

To put it another way. At the moment each candidate folder contains 6 pdf files. So that's 6x20=120pdfs in 20 folders.

Instead of the 6 pdf files appearing in individual candidate folders, I would like them to appear in (one) folder called 'Paper'. So that's 1x120=120pdfs.

Hope that makes sense, if not please let me know.

Since filenames in Main sheet don't appear to change for each Candidate, then the maximum number is rng1.cells.count + rng2.cells.count...

But the scores for each candidate do change which means that each candidate will have different files allocated to them???

Sorry Ken I'm a bit confused by your post. I am new to this so not sure exactly what you mean. All I am trying to do is get ALL files for each candidate in one folder instead of separate folders. That (one) folder is to be called 'Paper'. Pardon my ignorance but I thought it was a tweak of the code in my post14 ie. removing

For Each c2 In rng2
If Not .FolderExists(p2 & c2) Then pf.SubFolders.Add c2
Next c2

Apologies as looking back I think I should have made that clear in my original post.

As ever, thanks for your help and patience.

I'll work something up.

The point in #17 is that while you are only getting up to 5 for each candidate, those 5 may not be unique for all candidates. e.g. Candidate 1, has files 1,2,3,4,5. Candidate 6, has files 1,2,11,13,14. So, files 1 and 2 are duplicates. Since fso.CopyFile has an option to not overwrite, we can avoid excess overwrites.

I see.

No I do not want any overwrites as if candidate 1 has to re-do topic files 1 and 2 and candidate 2 has to also to do topic files 1 and 2, then those topic files (1 and 2) need to be allocated to both candidates. That's why I mentioned that in the (one) folder 'Paper1', there will be 120 pdf files. Yes there will be duplicates (and I need them) but the files are ordered with the 'main' candidate sheet in between each candidates topic files. I have attached screen shot so you know what I mean.

The tricky bit I think is to include the 1. / 2. / 3. / 4. / 5. etc. with each file name so that the files stay ordered and duplicates are there and not over written. Please see attached image. All candidates and all topic files would be labelled/numbered this way using the F1 cell reference?

Thanks again