How to drag drop file/s into a textbox from winexplorer?

[blurryanthem]

Hello , I'm trying to drag drop file/s into a textbox from windows explorer using vb6. I can't figure it out how to create textboxes at runtime depending on how many file selection did I make for dragdrop purposes. Is there a way to do that in vb6 and how?

Thanks alot and happy holidays.

[Guido Geurs]

Option Explicit
 
Private Sub Form_Load()
   Text1.OLEDropMode = 1      '§ manual
End Sub
 
Private Sub Text1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim DATACOUNTER As Integer
   With Text1
      On Error GoTo No_File_info
      For DATACOUNTER = 1 To Data.Files.Count
         .Text = .Text & Data.Files.Item(DATACOUNTER) & vbNewLine
      Next
   End With
Exit Sub
No_File_info:
   MsgBox "No File name from Explorer"
End Sub
 

[blurryanthem]

Hello Sir Geur,

Thanks for the code. But It seemed like it was only able to copy all the selected files in one textbox. It did not even create a new line if that is the purpose of vbNewLine?

The requirement is to be able to drag multiple files ( ex. 3 files ) into my vbform and drop those files in 3 textboxes at runtime displaying their filenames. I do not limit the dragging to 3files only but even more. Is that possible sir?

Thanks!

[blurryanthem]

It only showed the varchar sign to separate the selected files. I would want to display each selected dragged file into different textboxes.

[Guido Geurs]

It's for VB6 , no ??

If You want more than one line in a textbox set the property "Multiline" to TRUE (see attached GIF)

Do You want multy Textboxes DEPENDING on the number of selected filenames (see attachment "Textboxes.GIF) ?

Or are there a max of textboxes on the form (like 10 or so)

[blurryanthem]

Sir Geur,

I am actually making a file replicator tool as a simple project that will enable a user to locate a file to copy ( in my cases from explorer ) and then replicate it a number of times. That's why I need to display each copied files in different textboxes so that user is given an option to specify how many times each different image is to be replicated. And yes..I would need Textboxes.jpg format.

Thanks sir.

[blurryanthem]

Sorry..but yes It's VB6. I was thinking of unlimitted file selection so I am expecting for a number of textboxes too. Just to give the user big option in the file selection and file replication.

[Guido Geurs]

Attached is a code.
Just drop a bunch of files in the Image and the textboxes will be created with the filename in it.

[blurryanthem]

I have tried the code and it seemed like it's limitation is during the file selection. Yes it allows the user to for multiple file selection from the same directory only at one time then drag it to the image. But it would be a problem if some files to be selected are located in another directory. Doing the 2nd thing proceeds to the Error trapping which is confusing :(

Or do you have any better idea on how to allow the user to do single/multiple file selection then drag the chosen files at the same time or not , then populate those filenames in different textboxes? That is the only way that I can think of now.

The desired tool looks like this ..sorry I just got back in the coding thing.

[Guido Geurs]

The sample is just explaining how to multiply textboxes according to the number of files.
The code is not complete to redo it or add other files !!!(the textboxes must be cleared)

Sorry but it's still not clear to me what You want to do with the files.
What I under stand (?) for now is that You want to centralize different files from different folder in textboxes.
WHY textboxes and not a listbox?
What do You want to do with these filenames?

Do You have already some code?
Please attach it in Bytes if possible.

[blurryanthem]

Hello Sir Geur,
Sorry if that confused you.

I'm trying to create a file replicator tool which will enable the user to copy/replicate certain files a no. of times and save it into a directory/drive.

On the tool:
FileSearch Button -> Opens the windows explorer ( for file selection )


Textbox1
-> where filename of selected file is displayed ( wherein selection from explorer should be via drag and drop for ease of use )
-> should only appear when a file is drag/drop in the FilestoCopy Frame
-> may add more textboxes at run time depending on how many files were selected

During a drag/drop
-> another textbox ( or any container/editor) should be created at the right side of the textbox for the filename show, purpose of the textbox at the right is it is where user will manually input no. of times that specific file is to be copied/replicated in a certain drive.

I just can't find how to do that. I have only these ones for now.

Private Sub Command1_Click()
    Dim Det As Long
    Det = Shell("explorer.exe /e, C:\", vbNormalFocus)
 
End Sub
 
Private Sub Command3_Click()
TextBox.Text = ""
End Sub
 
Private Sub Form_Load()
    TextBox.OLEDropMode = 1      '§ manual
End Sub
 
Private Sub TextBox_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
 
Dim i As Integer
    Load Text1(DATACOUNTER)
    With TextBox
       For i = 1 To Data.Files.Count
          .Text = .Text & Data.Files.Item(i) & vbNewLine
       Next
    End With
 End Sub
 

[blurryanthem]

If there is a better way of doing it, I hope you could help. Thanks in advance.

[Guido Geurs]

If I'm right, it looks like in the attached GIF ?

[blurryanthem]

More or less like this too:

Here's the modified code though.

Option Explicit
 
Private Sub ClearAllBtn_Click()
Text1.Text = ""
End Sub
 
Private Sub OpenWEBtn_Click()
    Dim Det As Long
    Det = Shell("explorer.exe /e, C:\", vbNormalFocus)
End Sub
 
Private Sub Form_Load()
    DropArea.OLEDropMode = 1      '§ manual
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
On Error GoTo No_File_info
For i = 1 To Data.Files.Count
Load Text1(i)
        With Text1(i)
            .Top = Text1(0).Top + i * (Text1(0).Height + 15)
            .Text = Data.Files.Item(i)
            .Visible = True
        End With
      Next
    Exit Sub
No_File_info:
   MsgBox "No File name from Explorer"
End Sub
 
 

To Dos yet:
a. I'm still having trouble with ClearList button
b. Has not coded for Replicate Button yet
c. Has not figured out how to create again new textboxes to contain the no. of copy numbers

Thanks!

[Guido Geurs]

Questions=
Q1 All the selected files must be replicated with the same number (one textbox for the number)?
Or the user enters a number for each file (each file has a textbox with his number of replacations)?
Q2 the number of files for each replacation is not higher than +- 20 because there is no place in the form if more.
If it's more, we have to use a listbox or gridbox (depends on the answer on Q1)
Or a scrolling picturebox (max +_ 40 files).

[blurryanthem]

Answers:
Q1 All the selected files must be replicated with the same number (one textbox for the number)?
Or the user enters a number for each file (each file has a textbox with his number of replacations)?
- The user enters a number ( for no. of copy ) for each file ( may be the same, maybe not depending on the user )
- We could limit the digit entry to be max of 5 digits
Q2 the number of files for each replacation is not higher than +- 20 because there is no place in the form if more.
If it's more, we have to use a listbox or gridbox (depends on the answer on Q1)
- i would want the program to give no limit to the number of files to be selected , then dragged and dropped into the frame.. i'm not familiar how gridbox works.. but I'm a bit comfortable with textboxes
- is there a way to automatically extend/stretch the form below depending on the no of textboxes created?
- if Listbox.. how do I create a another container for the number entry ( no. of copy ) for each populated file in the list box?
Or a scrolling picturebox (max +_ 40 files).

[blurryanthem]

as for picturebox...i believe it does not support all file types.. correct?

[Guido Geurs]

Attached an example how it can be done with textboxes
There is a limit with textboxes !!! = the top of the sliding frame !!!

I will see what i can do with a grid.

[Guido Geurs]

Attached are examples with:
v2.1 = with GRID : need an image to drop in the data.
v3.2 = with MSFlexGrid : no need for image to drop in: MSFlexGrid has his own "dragdrop" event.

[blurryanthem]

Hello Mr Geur,
Sorry for the delayed response due to the Holidays. Happy Holidays by the way :)

I was not able to run drag drop files into a textbox from winexplorer_v2.1.zip , but I will try the other 2 with textboxes and grid.

[blurryanthem]

Sir Geurs,

Thanks alot, I used "drag drop files into a textbox from winexplorer_v1.1.zip" as I prefer a textbox in my form. I loaded a checkbox as well using the same control array with the textboxes created at runtime.

The checkbox will be used later on to select final files for removal or replication ( in case the user mistakenly dragged/dropped a file ).

Can I use the same control array as my counter to be able to remove/replicate "checked" files? It will be easier to indicate them in checkboxes and provide only 1 REMOVE and REPLICATE button for the file manipulation.

Creation of textboxes and checkboxes at run time:

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 NumEntryBtn(i + dCount)
         With NumEntryBtn(i + dCount)
            .Top = NumEntryBtn(i + dCount - 1).Top + NumEntryBtn(0).Height
            '.Text = i + dCount
            .Visible = True
         End With
 
        Load CheckBtn(i + dCount)
        With CheckBtn(i + dCount)
            .Top = CheckBtn(i + dCount - 1).Top + CheckBtn(i + dCount - 1).Height
            .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
 

Unload Checkbx, Textbox corresponding to that checked checkbox in the array:

Private Sub Clear_Click()
Dim i As Integer
 
        For i = 1 To CheckBtn.Count
            If CheckBtn(i).Value = vbChecked Then
            Unload Text1(i)
            Unload NumEntryBtn(i)
            Unload CheckBtn(i)
            End If
        Next
 
End Sub
 

Is this correct?

[blurryanthem]

Sir Geurs,

You think this is better?

Thanks!

[Guido Geurs]

Looks OK but one question:
Why add a checkbox ? You can use a pop-up menu like in attachment v1.2.
One problem: if You delete a textbox, the index of the boxes will not be continues any more!! => how to program which indexes still exist and which not ???
There is also in the code the count used textboxes (= textbox.count) :o( to calculate the indexes for the next drop !
There is an other way: move the data one box up and delete the last textbox ?

I have also attached a new ZIP with the 2.1 version: it works on my PC (with XP Pro SP 3 and VB6 SP6)

[Guido Geurs]

attached v1.3 with delete and scroll-up of the data.
Use LMB on the textbox to delete (to pop-up the delete menu).

[blurryanthem]

Sir Geur,

I think that a checkbox is for ease selection of which file to delete and replicate.

I have tried your v1.3 ( with delete and scroll-up of the data ) and deletion was not a problem. Although, I'm seeing that it would be a bit tedious for the user to manually click each of the files that needs to be deleted. While if we use checkbox, we will only hit one "remove/delete" button for all selected files ( w. checked checkboxes).

Do you agree?

Because the next thing that I would work here is the replicate to x times command.

[Guido Geurs]

I think there are 2 types of deletion:
The PUmenu delete is only used for deletion of a file the user don't want replicate (has been dropped by mistake)
A button with delete for clearing the boxes with the code=

For i=1 to textfiles.count
  unload textfiles(i)
  unload texttimes(i)
next

This way You don't need the checkboxes !

[blurryanthem]

Hello Sir Geur,

I've followed your suggestion about the pop up menus instead of checkboxes. This makes it alot easier now to select which files to delete if added mistakenly. This way the remaining files will be by default all the ones which should undergo the replication process.

I would like to ask though if there is a way in VB to save the selected files by by extracting the filenames from the full directory path? Then save it by listing.

Ex.
C:\dell\drivers\R182522\Help.txt ( ex. 5x to be copied)
C:\dell\drivers\R182522\test.dll ( ex. 3x to be copied)

Save this selected file to a specified directory with filename:

Help(1).txt
Help(2).txt
Help(3).txt
Help(4).txt
Help(5).txt
test(1).dll
test(2).dll
test(3).dll

I can't seem to extract the filename itself other than assigning a fix filename with index to all copied files..which is not helping. Any help Sir Geur?

Thanks

[Guido Geurs]

You can extract the filename from the path by cutting the string after the last "\" with:

FILENAME = Mid(TextFiles(xx),Instrrev(TextFiles(xx),"\")+1)

For adding an index: cut the FILENAME before and after the last "." like:

NAME = Left(FILENAME,Instrrev(FILENAME,".")-1)
EXTENTION = Mid(FILENAME,Instrrev(FILENAME,".")+1)

Recombine the destination filename with index:

FILETO = NAME & "(" & index & ")" & EXTENTION

[blurryanthem]

Sir Geur,

Does TextFiles(xx) stand for the textbox with the fullpath and file name in my prog? And does (xx) stand for it's array? All about this get filename is on one function right not part of the Replicatebtn_click() sub?

like in my code:

For i =1 To Text1.count
FILENAME = Mid(Text1(i),Instrrev(Text1(i),"\")+1)


In my ReplicateBtn_click() , can I use the FileCopy? like

FileCopy Text1.Text, SaveTo.Text

Is this correct?

[blurryanthem]

I have actually asked the same thing for the replication process. I'm still really learning from this VB thing in which I am trying to enhance the old tool.

http://bytes.com/topic/visual-basic/...values-runtime

[Guido Geurs]

Yes, TextFiles(xx) is the textbox in the list and xx is the index of the textboxes in the frame.

the code for ReplicateBtn_click() will be something like:

Private Sub ReplicateBtn_click()
Dim FILENAME as string
Dim NAME as string
Dim EXTENTION as string
Dim FILETO as string
Dim STARTFILEidx as integer
Dim FILEidx as integer
Dim LOGTEXT as string
  '§ Loop trough files to copy
  for STARTFILEidx  = 1 to textfiles.count -1
    '§ find FILENAME (NAME + EXTENTION)
    FILENAME = Mid(TextFiles(STARTFILEidx ),Instrrev(TextFiles(STARTFILEidx ),"\")+1)
    '§ find NAME
    NAME = Left(FILENAME,Instrrev(FILENAME,".")-1) 
    '§ find EXTENTION
    EXTENTION = Mid(FILENAME,Instrrev(FILENAME,".")+1)
      '§ Make copies
      for FILEidx =1 to val(textCopies(STARTFILEidx).text)
        FILETO = NAME & "(" & FILEidx & ")" & EXTENTION  
        FileCopy textfiles(STARTFILEidx), TextToPath.text & "\" & FILETO
        '§ add filename for printing log
        LOGTEXT= LOGTEXT & FILETO & Vbnewline
      next
  next
  '§ print Log
  ...
  ...
End Sub

PS: this code is not tested !!! I have just typed it in de mail !!!!

[blurryanthem]

Thanks for the confirmation Sir Geurs.
So val(textCopies.text) means any value that I enter to my CopyTimes.text, right?

I will try this code in a little while and tell you if it works.

[Guido Geurs]

It's recommended to add errortraps in the code!
Check if the file already exist in the folder before copying it with something like:

Dim FILENAME As String
Dim NAME As String
Dim EXTENTION As String
Dim FILETO As String
Dim STARTFILEidx As Integer
Dim FILEidx As Integer
Dim LOGTEXT As String
   '§ Loop trough files to copy
   For STARTFILEidx = 1 To TextFiles.Count - 1
      '§ find FILENAME (NAME + EXTENTION)
      FILENAME = Mid(TextFiles(STARTFILEidx), InStrRev(TextFiles(STARTFILEidx), "\") + 1)
      '§ find NAME
      NAME = Left(FILENAME, InStrRev(FILENAME, ".") - 1)
      '§ find EXTENTION
      EXTENTION = Mid(FILENAME, InStrRev(FILENAME, ".") + 1)
         '§ Make copies
         For FILEidx = 1 To Val(TextTimes(STARTFILEidx).Text)
            FILETO = NAME & "(" & FILEidx & ")" & EXTENTION
            If Dir$(TextToPath.Text & "\" & FILETO) <> "" Then
               MsgBox ("The file " & FILETO & " exist !")
               Exit Sub
            End If
            FileCopy TextFiles(STARTFILEidx), TextToPath.Text & "\" & FILETO
            '§ add filename for printing log
            LOGTEXT = LOGTEXT & FILETO & vbNewLine
         Next
   Next
   '§ print Log
 
 

PS:
Val(TextTimes(STARTFILEidx).Text) is the number of copies

[blurryanthem]

Sir Geur,

I just tried your code above and yes it does work with a little error wherein the files copied were saved as:

ABT GTI 00(1)jpg
ABT GTI 00(2)jpg
ABT GTI 00(3)jpg
CertificatePdfServlet_eantipal(1)pdf
CertificatePdfServlet_eantipal(2)pdf
CertificatePdfServlet_eantipal(3)pdf

Instead of :

ABT GTI 00(1).jpg
ABT GTI 00(2).jpg
ABT GTI 00(3).jpg
CertificatePdfServlet_eantipal(1).pdf
CertificatePdfServlet_eantipal(2).pdf
CertificatePdfServlet_eantipal(3).pdf

I just added a "." to how the FILETO is being written from your code:
FILETO = NAME & "(" & FILEidx & ")" & EXTENTION

To:
FILETO = NAME & "(" & FILEidx & ")" & "." & EXTENTION

Thanks alot Sir Geur. I've learned so much.
I'll work on the Log List and other file error trapping like:

a. copytimes no value
b. saveto folder already exist/does not exist
c. fileto already exist at saveto ( already at your code)
d. no dragged files - nothing to replicate

Query:
1. Is it practical to autoclear the list( textfiles) after a successful copy? Just to prepare again the for a new list
OR just create a clear button to clear the list?
2. Is it practical to set the SaveTo textbox to Locked? Just to prevent the user from editing a non-existent directory..
OR shall I keep it unlocked to give user freedom to create a new folder or manually change a directory?

The way I locked CopyTimes textbox for numeric entry only.

[Guido Geurs]

Yes You are right, I'm sorry for the error in the code.

Q1: I think an auto clear is not practical because, if there is an error while copying, all the work for building the list will be lost.

Q2: I think it's more practical to let the textbox editable for the user.
He can go to the path of an existing folder and change just a letter to create a new one.
The code must be adapted to it with=>
Before copying:
- check if the folder exist
- if not, ask the user if it must be created.

Q3 code for CopyTimes (max 5 digits: tested in = If Len(.Text) < 5 Then ...)

Private Sub TextTimes_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
   With TextTimes(Index)
      Select Case KeyCode
      Case 48 To 57 '§ numbers
         If Len(.Text) < 5 Then .Text = .Text & Chr(KeyCode)
      Case 8 '§ back
         If Len(.Text) > 0 Then _
            .Text = Left(.Text, Len(.Text) - 1)
      Case 46 '§ delete
         .Text = ""
      End Select
   End With
End Sub

[blurryanthem]

Sir Geur,

I am trying to enable the SaveTo to create a new directory in case a new folder will be created by user for new destination aside from the given directories. I'm just not sure what's wrong with my code here.. SaveTo.text gets the new directory value..but an error is being thrown out...It was not able to create a new directory :(

Private Sub SaveTo_Click()
Dim newDir As String
 
newDir = SaveTo.Text & "\"
On Error Resume Next
MkDir (newDir)
 
End Sub
 

It throws a run time error '76' Path not found.
Please help.

[blurryanthem]

I have to agree with your answer in my Q1. Anyways I just provided a new clear list button to answer that.

Private Sub ClearBtn_Click()
Dim i As Integer
        For i = 1 To Text1.UBound
             Unload Text1(i)
             Unload CopyTimes(i)
        Next
        Call Calc_FrameSlide_Height
End Sub
 

As for Q3 here is my previous code. This does not limit to any input length though which is a bit clumsy but locks any invalid keypresses. You think this is practical?

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
 

I'll try your new code for the CopyTimes.

[Guido Geurs]

You can't make folders with MkDir if there is more than one folder missing.
You can only create the last folder and the previous must exist!
Like starting from : C:\test1\test2
You want : C:\test1\test2\test3\test4
Or change a letter in the path : C:\test0\test2 (this is the same as creating 2 folders).

You have to build the path until the last folder.

The code to do that in the Duplicate command is:

Private Sub ComDuplicate_Click()
'§ Check Folder from TextSaveTo
Dim ARRFOLDERS() As String
Dim ARRFOLDERSidx As Integer
Dim ARRFOLDERScount As Integer
Dim PATHpart As String
Dim MESSAGE As Variant
'§ Loop trough files to copy
Dim FILENAME As String
Dim NAME As String
Dim EXTENTION As String
Dim FILETO As String
Dim STARTFILEidx As Integer
Dim FILEidx As Integer
Dim LOGTEXT As String
'§ Check Folder from TextSaveTo
   If Dir$(PATHpart, vbDirectory) <> "" Then
      MESSAGE = MsgBox("The folder = " & TextSaveTo.Text & " don't exist !" & _
                     vbNewLine & "Create the folder ?", vbYesNo)
      If MESSAGE = vbYes Then
         ARRFOLDERS = Split(TextSaveTo.Text, "\") '§ set folders in array
         For ARRFOLDERSidx = LBound(ARRFOLDERS) To UBound(ARRFOLDERS) '§ loop to folders
            PATHpart = ""
            For ARRFOLDERScount = LBound(ARRFOLDERS) To ARRFOLDERSidx '§ build path
               PATHpart = PATHpart & ARRFOLDERS(ARRFOLDERScount) & "\"
            Next
            If Dir$(PATHpart, vbDirectory) = "" Then MkDir (PATHpart) '§ create folders
         Next
      Else
         Exit Sub
      End If
   End If
'§ Loop trough files to copy
   For STARTFILEidx = 1 To TextFiles.Count - 1
      '§ find FILENA...
....
....

[Guido Geurs]

Q3 It's a nice code.
If it's working in Your program, it's OK.
Only 'Delete' is not working => If You want erase all, You have to place the cursor before the numbers for the key 'Delete' or after the numbers if You want use the 'Back'.

You can eliminate the restriction of 5 digits by changing the code=

      Case 48 To 57 '§ numbers
         If Len(.Text) < 5 Then .Text = .Text & Chr(KeyCode)
      Case 8 '§ back

by

      Case 48 To 57 '§ numbers
         .Text = .Text & Chr(KeyCode)
      Case 8 '§ back

[blurryanthem]

Sir Geur,

As with the creation of a new folder, is the ComDuplicate_Click() , a new button that should be added on my form?

As you can see I have the drivelist box with

Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
 

Which will populate to the DirListBox

Private Sub Dir1_Click()
SaveTo.Text = Dir1.Path
End Sub
 

Now I want this textbox ( SaveTo) to catch the Dir1.Path plus with an editable textbox that will enable the user to add/create new folder name to the SaveTo textbox.

I'm a bit confused with the new duplicate command button.?

[blurryanthem]

I did try to replicate thousand files a while ago to my destination drive and I was thinking that a progress indicator should also be added while copy/replication in progress to guide user that tool has not hanged or anything before replication confirmation is displayed. Any idea how?

[Guido Geurs]

Sorry for the confusion.
No this is not a new button but a peace of code to place before the code in the 'Copy' command to check if the folder exist.
I have renamed the elements in my code.
Please tell me if there are still names not conform with Yours, so I can rename them in my code and prevent confusions in the future. (see attachment)
I have also added a simple gouge to indicate the progress of copying.
To add or modify the foldername in the textbox, just set the textbox enabled=true

PS:
There was an error in previous code for checking the folders existence, it must be:

   If Dir$(SaveTo.Text, vbDirectory) = "" Then

[blurryanthem]

Sir Geur,

I've been working on the LogBtn. It was able to create a text file already, where I could also write the directory file list from my destination folder. However it was only able to write 1 copied file :(

This is the code.

Private Sub LogBtn_Click()
    Dim A As String
 
    A = Dir$(SaveTo & "*.*", vbDirectory)
    Open "c:\File List.txt" For Output As #1
    Write #1, A
    Close #1
 
End Sub
 

Thanks!

[blurryanthem]

Sir Geur,

I have already tried your code on creating new folder in a directory and it works good now.

However, I think I messed up with some of my error handling.. they are not working as expected.

In my replicate/duplicate button I need alot of file handling checking like:

1. "No file to replicate." - if user clicks replicate button but has not dragged any file yet a message should be prompted.

2. If file exist: File xx exist - replace file?
a. Yes - resume copy process
b. No - exit condition

( I don't know where should that reside in my file checking condition). I choose the vbOKCancel so that if OK is clicked ( an answer to replace existing file question ), the copy process will resume.. but if Cancel is clicked it will just exit the sub.

For STARTFILEidx = 1 To Text1.Count - 1
      '§ find FILENAME (NAME + EXTENTION)
      FILENAME = Mid(Text1(STARTFILEidx), InStrRev(Text1(STARTFILEidx), "\") + 1)
      '§ find NAME
      NAME = Left(FILENAME, InStrRev(FILENAME, ".") - 1)
      '§ find EXTENTION
      EXTENTION = Mid(FILENAME, InStrRev(FILENAME, ".") + 1)
         '§ Make copies
         For FILEidx = 1 To Val(CopyTimes(STARTFILEidx).Text)
            FILETO = NAME & "(" & FILEidx & ")" & "." & EXTENTION
            If Dir(SaveTo.Text & "\" & FILETO) <> "" Then
               MESSAGE = MsgBox(FILETO & " already exist." & _
                     vbNewLine & "Replace existing file ?", vbOKCancel)
               'LabelProgress.Caption = "Progress"
               Exit Sub
            End If
            FileCopy Text1(STARTFILEidx), SaveTo.Text & "\" & FILETO
            COPIESMADE = COPIESMADE + 1
            LabelProgress.Caption = "Copy Progress: COPIESMADE & " / " & NMBRCOPIES"
            ShapeProgress.Width = (COPIESMADE / NMBRCOPIES) * ShapeProgressBack.Width
            LOGTEXT = LOGTEXT & FILETO & vbNewLine '§ add filename for printing log
          Next
    LabelProgress.Caption = "Files successfully replicated."
    ShapeProgress.Width = 0
Next
FileError:
            Select Case Err.Number
 
            Case 61
            MsgBox ("Destination drive is full.")
 
            Case 70
            MsgBox ("Permission Denied. The Memory Device is write protected.")
 
            Case 71
            MsgBox ("Destination drive not available.")
            End Select
    '§ print Log
 

3. I haven't got any idea on how to work with my Log Button yet.. it only prints 1 file

Private Sub LogBtn_Click()
    Dim A As String
 
    A = Dir$(SaveTo & "*.*", vbDirectory)
    Open "c:\File List.txt" For Output As #1
    Write #1, A
    Close #1
 
End Sub
 

Thank you!

[blurryanthem]

Hello Sir Geur,

I think I got the code working already for my item 2. ( File exist, vbOKCancel ). Here's my code:

For STARTFILEidx = 1 To Text1.Count - 1
      '§ find FILENAME (NAME + EXTENTION)
      FILENAME = Mid(Text1(STARTFILEidx), InStrRev(Text1(STARTFILEidx), "\") + 1)
      '§ find NAME
      NAME = Left(FILENAME, InStrRev(FILENAME, ".") - 1)
      '§ find EXTENTION
      EXTENTION = Mid(FILENAME, InStrRev(FILENAME, ".") + 1)
         '§ Make copies
         For FILEidx = 1 To Val(CopyTimes(STARTFILEidx).Text)
            FILETO = NAME & "(" & FILEidx & ")" & "." & EXTENTION
            If Dir(SaveTo.Text & "\" & FILETO) <> "" Then
               MESSAGE = MsgBox(FILETO & " already exist." & _
                     vbNewLine & "Replace existing file ?", vbOKCancel)
               'LabelProgress.Caption = "Progress"
 
                If MESSAGE = vbOK Then
                FileCopy Text1(STARTFILEidx), SaveTo.Text & "\" & FILETO
                COPIESMADE = COPIESMADE + 1
                LabelProgress.Caption = "Copy Progress:" & COPIESMADE & " / " & NMBRCOPIES & ""
                ShapeProgress.Width = (COPIESMADE / NMBRCOPIES) * ShapeProgressBack.Width
                LOGTEXT = LOGTEXT & FILETO & vbNewLine '§ add filename for printing log
                Else
                Exit Sub
                End If
 
            End If
                FileCopy Text1(STARTFILEidx), SaveTo.Text & "\" & FILETO
                COPIESMADE = COPIESMADE + 1
                LabelProgress.Caption = "Copy Progress:" & COPIESMADE & " / " & NMBRCOPIES & ""
                ShapeProgress.Width = (COPIESMADE / NMBRCOPIES) * ShapeProgressBack.Width
                LOGTEXT = LOGTEXT & FILETO & vbNewLine '§ add filename for printing log
          Next
            LabelProgress.Caption = "Files successfully replicated."
            ShapeProgress.Width = 0
 

I hope you could help me with the issue 1 and 3.

Thanks!

[Guido Geurs]

Q1 = If there is only 1 textbox with filenames (the original with index=0 ) then there are no copies: so no files dropped.
Place this code at the beginning of the command code:

'§ check if Files to copy <> 0
   If TextFiles.Count = 1 Then
      MsgBox "There are no files to copy !" & vbNewLine & _
               "Please, drop files into the Dropzone !"
      Exit Sub
   End If

Q2 = I have also added the possibility if the user just not want to uverwrite this one file.
The program continues with the next file.

         '§ Make copies
         For FILEidx = 1 To Val(CopyTimes(STARTFILEidx).Text)
            FILETO = NAME & "(" & FILEidx & ")" & "." & EXTENTION
            If Dir(SaveTo.Text & "\" & FILETO) <> "" Then _
               MESSAGE = MsgBox("The file " & FILETO & " exist !" & vbNewLine & _
                        "Replace ? [Yes]" & vbNewLine & _
                        "No for only this one [No]" & vbNewLine & _
                        "Cancel All [Cancel]", vbYesNoCancel)
            If MESSAGE = vbCancel Then Exit Sub
            If MESSAGE = vbNo Then
               NMBRCOPIES = NMBRCOPIES - 1
               GoTo NextFile
            End If
            FileCopy TextFiles(STARTFILEidx), SaveTo.Text & "\" & FILETO
            COPIESMADE = COPIESMADE + 1
            LabelProgress.Caption = "Progress : " & COPIESMADE & "/" & NMBRCOPIES & " copy-ed"
            ShapeProgress.Width = (COPIESMADE / NMBRCOPIES) * ShapeProgressBack.Width
            LOGTEXT = LOGTEXT & FILETO & vbNewLine '§ add filename for printing log
NextFile:
         Next
   Next

Q3 = In the copy code is also added a var LOGTEXT(string)
which keep track of the copied files.
Just dump this data in a textfile with:

Private Sub ComSaveLog_Click()
Dim MESSAGE As Variant
Dim OUTPUTFN As Integer
   If Dir(SaveTo.Text & "\Log.txt") <> "" Then _
      MESSAGE = MsgBox("The file Log.txt exist !" & vbNewLine & "Overwrite ?", vbOKCancel)
   If MESSAGE = vbCancel Then Exit Sub
   OUTPUTFN = FreeFile
   On Error GoTo ErrWriting
   Open SaveTo.Text & "\Log.txt" For Output As #OUTPUTFN
      Print #OUTPUTFN, LOGTEXT
   Close #OUTPUTFN
Exit Sub
ErrWriting:
   Close #OUTPUTFN
   MsgBox ("There is an error writing the settings file !")
End Sub

[blurryanthem]

Sir Geur,

I have added these codes to handle the ff error trapping..let me know if the codes are fine:

a. '§ Opens Saved Log file (Replicate button )

Private Sub LogBtn_Click()
    Dim LogFile As String
    LogFile = "notepad c:\Log.txt"
    Shell LogFile
End Sub
 

b. If file exists ( replace Ok/Cancel)

'§ Loop through files to copy
   COPIESMADE = 0
   'LabelProgress.Caption = "Copy Progress"
 
For STARTFILEidx = 1 To Text1.Count - 1
      '§ find FILENAME (NAME + EXTENTION)
      FILENAME = Mid(Text1(STARTFILEidx), InStrRev(Text1(STARTFILEidx), "\") + 1)
      '§ find NAME
      NAME = Left(FILENAME, InStrRev(FILENAME, ".") - 1)
      '§ find EXTENTION
      EXTENTION = Mid(FILENAME, InStrRev(FILENAME, ".") + 1)
         '§ Make copies
         For FILEidx = 1 To Val(CopyTimes(STARTFILEidx).Text)
            FILETO = NAME & "(" & FILEidx & ")" & "." & EXTENTION
            If Dir(SaveTo.Text & "\" & FILETO) <> "" Then
               MESSAGE = MsgBox(FILETO & " already exist." & _
                     vbNewLine & "Replace existing file ?", vbOKCancel)
               'LabelProgress.Caption = "Progress"
 
                If MESSAGE = vbOK Then
                FileCopy Text1(STARTFILEidx), SaveTo.Text & "\" & FILETO
                COPIESMADE = COPIESMADE + 1
                LabelProgress.Caption = "Copy Progress:" & COPIESMADE & " / " & NMBRCOPIES & ""
                ShapeProgress.Width = (COPIESMADE / NMBRCOPIES) * ShapeProgressBack.Width
                LOGTEXT = LOGTEXT & FILETO & vbNewLine '§ add filename for printing log
                Else
                Exit Sub
                End If
 
            End If
                FileCopy Text1(STARTFILEidx), SaveTo.Text & "\" & FILETO
                COPIESMADE = COPIESMADE + 1
                LabelProgress.Caption = "Copy Progress:" & COPIESMADE & " / " & NMBRCOPIES & ""
                ShapeProgress.Width = (COPIESMADE / NMBRCOPIES) * ShapeProgressBack.Width
                LOGTEXT = LOGTEXT & FILETO & vbNewLine '§ add filename for printing log
          Next
            LabelProgress.Caption = "Files successfully replicated."
            ShapeProgress.Width = 0
 
            '§ print Log
            sFilename = "c:\Log.txt"
 
            'obtain the next free file handle from the
            'system and and save the text box contents
            hFile = FreeFile
            Open sFilename For Output As #hFile
            Print #hFile, LOGTEXT
            Close #hFile
 

c. No copy destination ( if SaveTo.Text has no value )

 , if replicate button is pressed
If SaveTo.Text = "" Then
      MsgBox ("Please specify a copy destination.")
End If
 

d. I don't have error handling yet to check if there are no chosen/dragged files when replicate button is pressed.

[Guido Geurs]

Seems to be OK.
You can define how the Notepad window must be opened by:

Private Sub ComShowLog_Click()
Dim NOTEPADSHELL As Double
   NOTEPADSHELL = Shell("Notepad " & SaveTo.Text & "\Log.txt", vbNormalFocus)
End Sub

No need to proceed with the code if there is no destination folder (exit sub) so the code can be:

....
'§ check if Files to copy <> 0
   If TextFiles.Count = 1 Then '§ only the original textbox with index=0
      MsgBox "There are no files to copy !" & vbNewLine & _
               "Please, drop files into the Dropzone !"
      Exit Sub
   End If
....

[blurryanthem]

a. I think I have to consider your suggestions with the conditions if a file already exist.

"Replace ? [Yes]" & vbNewLine & _
"No for only this one [No]" & vbNewLine & _
"Cancel All [Cancel]", vbYesNoCancel)

Thanks for the idea.

b. I have already added the checking for "No file to replicate." and it worked already.

[blurryanthem]

Hello Sir Geur,

I modified your code a bit in the situation wherein no destination drive is specified, since program was still able to continue with the code instead of exiting the sub and copies the files at root of c:\

'§ check if Files to copy <> 0
    If TextFiles.Count = 1 Then '§ only the original textbox with index=0
       MsgBox "There are no files to copy !" & vbNewLine & _
                "Please, drop files into the Dropzone !"
       Exit Sub
    End If
 

Modified code. ( This already works, and exits the sub.no copy process is performed )

If Text1.Count = 1 Then
       MsgBox "There are no files to copy." & vbNewLine & _
                "Please, drop files into the drop zone."
    Else
    Exit Sub
End If
 

Thanks!