How to replicate file/s "x" times in a directory all with dynamic values at runtime?

[blurryanthem]

Hello,

I am trying to create a program that would replicate different selected files "x" times into a specified directory and save them with filename indexes. Then after create a log list of the successfully copied files via LogListBtn click ( maybe saving the text file in the C: root)

ex.
a. Help.txt ( copy 3x ), Report.xls ( copy 2x )

When they are saved in a specified directory they should look like:

Help(1).txt
Help(2).txt
Help(3).txt
Report(1).xls
Report(2).xls

By the way this is my code in adding the selected files by drag dropping them in a FRAME, then creating 2 textboxes in 1 row where:

Text1 ( as textbox ) - where full path and filename is displayed
CopyTimes ( as textbox ) - number entry for x times a file is to be copied

Private Sub DropArea_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Integer
Dim dCount As Integer
 
      On Error GoTo No_File_info
      i = Text1.count - 1
 
      For dCount = 1 To Data.Files.count
 
         Load Text1(i + dCount)
         With Text1(i + dCount)
            .Top = Text1(i + dCount - 1).Top + Text1(0).Height
            .Text = (Data.Files.Item(dCount))
            .Visible = True
 
         End With
 
         Load CopyTimes(i + dCount)
         With CopyTimes(i + dCount)
            .Top = CopyTimes(i + dCount - 1).Top + CopyTimes(0).Height
            '.Text = i + dCount
            .Visible = True
         End With
 
      Next
      FrameSlide.Height = Text1.count * Text1(0).Height
      If FrameSlide.Height > FrameFix.Height Then
         With VScrollFiles
            .Max = (FrameSlide.Height - FrameFix.Height) / 10
            .SmallChange = 200
            .LargeChange = FrameFix.Height / 10
            .Visible = True
         End With
      Else
         VScrollFiles.Visible = False
      End If
Exit Sub
No_File_info:
   MsgBox "No File name from Explorer"
End Sub
 

I can't seem to find a code on how to replicate these files to my destination directory which is at SaveTo ( as textbox ).


This is the full code of the program:

Option Explicit
Dim fselectIDX As Integer
 
Private Sub CopyTimes_KeyPress(Index As Integer, KeyAscii As Integer)
If Not (KeyAscii = vbKeyBack) Then
    If Not Chr(KeyAscii) Like "#" Then
    KeyAscii = 0
    MsgBox ("Number entry only.")
    End If
End If
End Sub
 
Private Sub Form_Load()
    DropArea.OLEDropMode = 1      '§ manual
    Text1(0).Top = -Text1(0).Height + 180
    CopyTimes(0).Top = -CopyTimes(0).Height + 180
 
    With VScrollFiles
      .Visible = False
      .Min = -30
   End With
 
End Sub
 
 
Private Sub Dir1_Click()
SaveTo.Text = Dir1.Path
End Sub
 
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
 
Private Sub OpenWEBtn_Click()
    Dim Det As Long
    Det = Shell("explorer.exe /e, C:\", vbNormalFocus)
End Sub
 
Private Sub DropArea_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Integer
Dim dCount As Integer
 
      On Error GoTo No_File_info
      i = Text1.count - 1
 
      For dCount = 1 To Data.Files.count
 
         Load Text1(i + dCount)
         With Text1(i + dCount)
            .Top = Text1(i + dCount - 1).Top + Text1(0).Height
            .Text = (Data.Files.Item(dCount))
            .Visible = True
 
         End With
 
         Load CopyTimes(i + dCount)
         With CopyTimes(i + dCount)
            .Top = CopyTimes(i + dCount - 1).Top + CopyTimes(0).Height
            '.Text = i + dCount
            .Visible = True
         End With
 
 
      Next
      FrameSlide.Height = Text1.count * Text1(0).Height
      If FrameSlide.Height > FrameFix.Height Then
         With VScrollFiles
            .Max = (FrameSlide.Height - FrameFix.Height) / 10
            .SmallChange = 200
            .LargeChange = FrameFix.Height / 10
            .Visible = True
         End With
      Else
         VScrollFiles.Visible = False
      End If
Exit Sub
No_File_info:
   MsgBox "No File name from Explorer"
End Sub
 
 
Private Sub Text1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
   fselectIDX = Index
   If Button = vbKeyLButton Then PopupMenu PUMenu_Files
End Sub
'§ =============================================
'§ MENUS
'§ =============================================
 
Private Sub PUMenu_DeleteFile_Click()
Dim BOXidx As Integer
   If fselectIDX <> Text1.count Then '§ if not last box
      For BOXidx = fselectIDX To Text1.count - 2
         Text1(BOXidx).Text = Text1(BOXidx + 1).Text
         CopyTimes(BOXidx).Text = CopyTimes(BOXidx + 1).Text
      Next
      Unload Text1(Text1.count - 1)
      Unload CopyTimes(CopyTimes.count - 1)
   Else '§ if last box
      Unload Text1(fselectIDX)
      Unload CopyTimes(fselectIDX)
   End If
   Call Calc_FrameSlide_Height
End Sub
 
Private Sub VScrollFiles_Change()
FrameSlide.Top = -VScrollFiles.Value * 10
End Sub
 
'§ =============================================
'§ FUNCTIONS
'§ =============================================
 
Private Function Calc_FrameSlide_Height()
   FrameSlide.Height = Text1.count * Text1(0).Height
   If FrameSlide.Height > FrameFix.Height Then
      With VScrollFiles
         .Max = (FrameSlide.Height - FrameFix.Height) / 10
         .SmallChange = 200
         .LargeChange = FrameFix.Height / 10
         .Visible = True
      End With
   Else
      VScrollFiles.Visible = False
   End If
End Function
 

Tool UI:

Buttons not working yet are:
a. Replicate Button
- should be able to replicate selected file/s into destination directory "x" times
b. Log List Button
- should be able to create a text file saved at C: root drive with name LogList.txt with format:

1. file(1).txt
2. file(2).txt
3. file(3).txt
4. file(1).xls
5. file(2).xls
.......



Please help.
Thanks!

[blurryanthem]

correction for the Tool UI ( I removed the checkboxes already).

I hope somebody could help me.

Thank You.