Copy/Paste files into new folders based on condition

[Kenneth Hobs]

Sub Save_PDF_Papers_5()  
  '(ByVal fname As String)  '--------------------------------------
  '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, rn
  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")


  With fso
    'CREATE INDIVIDUAL FOLDERS
    If Not .FolderExists(p2 & "Files") Then _
      .GetFolder(p2).SubFolders.Add "Files"
    If Not .FolderExists(p2 & "Files\Paper") Then _
      .GetFolder(p2 & "Files").SubFolders.Add "Paper"
    p2 = p2 & "Files\Paper\"
    Set pf = .GetFolder(p2)
  
    '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
      rn = Trim(wsM.[F1])
      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 & rn & "." & .GetFileName(c1), False
            count = count + 1
          End If
        End If
      Next c1
      wsM.Range("A1:H29").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        p2 & rn & "." & 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

[branston]

Thanks Ken - that's a great help and saves me a great deal of time.

[branston]

Hi Ken

Would just like to run this past you if that's OK?

If a particular candidate was to have 2 topic files that are the same topic file (which could happen in an exceptional circumstance e.g. Question 1a and Question 1b but both point to TOPIC_01.pdf sheet) in his/her top 5 <=50% would this piece of code over write the duplicate? I know we discussed not overwriting files for different candidates but for the same candidate we don't need duplicates! Sorry this is an oversight on my part. I suspect the below would throw up an error as there is no checking for duplicates before moving on and looping?




For Each c1 In rng1
If c1.Offset(, 3) <= 0.5 And count <= 5 Then
If .FileExists(c1) Then
.CopyFile c1, p2 & rn & "." & .GetFileName(c1), False
count = count + 1
End If
End If
Next c1

[Kenneth Hobs]

False means, do not overwrite if file exists already.

[branston]

False means, do not overwrite if file exists already.

OK great ... so I could just comment 'false' out?

Thanks so much

[Kenneth Hobs]

Change False to True and it will overwrite old file if it exists.

Say you had duplicates, e.g. 1,2,3,1,1. For count of 5, there would be 3 files added . If you want 5, providing the 0.5 limit is met, then you would check if file exists first. If so, you have to decide to overwrite or skip the count, and overwrite and not increment the counter. It just depends on what you want....

[branston]

OK Ken …. so I have stumbled across an issue here that I hadn't foreseen.

Every candidate must always have 5 sheets. Now for some candidates it may mean 1,2,3,4,5 but if another candidate had 1,2,3,1,1 (like you said) then the count needs to keep running to ensure that the candidate has 5 sheets (not 3 in this case). I hope that makes sense.

I'm confused as to how for some you decide to overwrite ie. True but for others it would be False. Or is it the case that I need to adjust the count?

[Kenneth Hobs]

Just state the goal. I'll decide how to code it.

e.g.
Given: Files 1,2,1,1,5,6,7,7,9 all are <= 0.5 for candidate 1.

Soln:
1. 1,2,5,6,7.
2. 1,2,5.
3. or?

I am thinking (1).

[branston]

Yes Ken 1. as each candidate must have 5 topic files (+1 candidate sheet).

Thanks a lot - greatly appreciated.

[Kenneth Hobs]

'If c1.Offset(, 3) <= 0.5 And count <= 5 Then        
If c1.Offset(, 3) <= 0.5 And count <= 5 And _
  Not .FileExists(p2 & rn & "." & .GetFileName(c1)) Then

[branston]

Thanks Ken that seems to have done the trick.

[branston]

Hi Ken

Sorry to bother again but I am trying to give the user two options. One where all the files appear in one folder and one where all the files appear in individual folders.

I have amended the code below to do this for individual folders and it's working fine but the files appear outside the folders instead of inside each individual folder. Could you tell me where I am going wrong?

    For i = 1 To rng2.Rows.count
      wsM.[F1] = rng2(i).Offset(, -1) 'Reference number for candidate
      rn = Trim(wsM.[F1])
      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 Andcount <= 5 And _
        Not .FileExists(p2 & rn &"." & .GetFileName(c1)) Then
          If .FileExists(c1) Then
          .CopyFile c1, p2 & "\" & rn & "." & .GetFileName(c1)
            count =count + 1
          End If
        End If
      Next c1

[branston]

Hi Ken

I thought I had fixed it with the below by using Trim, however now I don't necessarily get 5 files for each candidate in each folder. Some only have 4 so the loop is not continuing to ensure each candidate gets 5 files. I can't see why though as it's set to 'true' with nested IFs checks. I've also added #30 code. This is for indivudal folders. Can you help?

    For i = 1 To rng2.Rows.count
      wsM.[F1] = rng2(i).Offset(, -1) 'Reference number for candidate
      rn = Trim(wsM.[F1])
      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 And _
        Not .FileExists(p2 & rn & "." & .GetFileName(c1)) Then
          If .FileExists(c1) Then
            .CopyFile c1, p2 & Trim(wsM.[c2]) & "\" & rn & "." & .GetFileName(c1), True
            count = count + 1
          End If
        End If
      Next c1

    Next i

[Kenneth Hobs]

I can see 2 cases where it could be less than 5.

1. Duplicate file name exists.
2. There are fewer than 5 matched rows with <= 0.5.

[branston]

1. I have a candidate that has 8 files <=50% but only the first 4 show as there's one duplicate in the first 5 files
2. As above he has 8 files <=50%

If I use the code below I get the desired result but the 5 files for each candidate appear outside each candidates folder

 If c1.Offset(, 3) <= 0.5 Andcount <= 5 And _
        Not .FileExists(p2 & rn &"." & .GetFileName(c1)) Then
          If .FileExists(c1) Then
          .CopyFile c1, p2 & "\" & rn & "." & .GetFileName(c1)
            count =count + 1

However if use the code on post 33 (below) I get the files inside the candidate folder but not necessarily 5. All I've added here is the 'Trim' function

For Each c1 In rng1
        If c1.Offset(, 3) <= 0.5 And count <= 5 And _
        Not .FileExists(p2 & rn & "." & .GetFileName(c1)) Then
          If .FileExists(c1) Then
            .CopyFile c1, p2 & Trim(wsM.[c2]) & "\" & rn & "." & .GetFileName(c1), True
            count = count + 1
          End If
        End If
      Next c1

    Next i

I can't see why I shouldn't get 5 files on the second bit of code?

[branston]

Ken I have attached images of what's happening. Hopefully this helps? The Candidate Range File appears inside the folder, the code is looping correctly (ie. keeps going 'til 5 files are copied even though I changed the filepaths so that Topic2 appears twice), however the topic files appear outside the candidate folder??? I don't know why?

The code for this is below. (It's using late binding fso)

  Dim fso As Object, pf As Object  'Late Binding

 With fso
    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)
      rn = Trim(wsM.[F1])
      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 And _
        Not .FileExists(p2 & rn & "." & .GetFileName(c1)) Then
          If .FileExists(c1) Then
          .CopyFile c1, p2 & "\" & rn & "." & .GetFileName(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
'--------------------------------------

[branston]

Hi Ken

Think I fixed it by adjusting thes lines

Not .FileExists(p2 & Trim(wsM.[c2]) & "\" & Trim(wsM.[c2]) & rn & "." & .GetFileName(c1)) Then
          If .FileExists(c1) Then
           .CopyFile c1, p2 & Trim(wsM.[c2]) & "\" & Trim(wsM.[c2]) & rn & "." & .GetFileName(c1)