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.

[blurryanthem]

Hello Sir Geur,

I think I've made it work as to what I need with the tool. Please take a check with its functionality and see if there are still areas that are buggy or needs improvement.

Thank you so much for your unselfish help. I was able to learn alot while studying your codes at the same time and was able to refresh my vb knowledge that has been stucked for 5 years now.

Attached is the tool.

Thanks alot!
Emily

[blurryanthem]

I just found a bug wherein if a copy process is ongoing and a file exist halfway the process and then I press cancel... the copy process was stopped but the progress bar does not go back to zero.

I tried to insert the lines below but program does not seem to read it..I don't know why.

         If MESSAGE = vbCancel Then Exit Sub
          ShapeProgress.Width = 0
          LabelProgress.Caption = "Copy Cancelled."
         If MESSAGE = vbNo Then GoTo NextFile
         FileCopy Text1(STARTFILEidx), SaveTo.Text & "\" & FILETO
 

[Guido Geurs]

Resetting the progressbar must be done before You Exit the Sub:

         If MESSAGE = vbCancel Then
            LabelProgress.Caption = "Copy Canceled."
            ShapeProgress.Width = 0
            Exit Sub
         End If

When I click Log then Notepad opens but Minimized.
I have changed the code to :

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

In my code is the progressbar working (see attachment).
Is in Your code the indication Shape on top of the background of the progressbar?

I have also added in the log the type of copy: "replaced" or "New" and "Canceled" if so.

I don't understand Your previous mail in which You say: "the situation wherein no destination drive is specified, since ..."
and You modify the code for no files dropped = "If Text1.Count = 1 Then
MsgBox "There ..." ???

and I think there is an error in it because You "Exit it" when there are files dropped: (if Count = 1 => Msg
ELSE => Exit sub ...)

" If Text1.Count = 1 Then
MsgBox "There ...
Else
Exit Sub
End If

PS:
It was a pleasure helping You because I learn more by working and searching for solutions on an existing problem than reading 10 books of programming.
If You have still questions, please don't hesitate and place them in a call on Bytes.

[blurryanthem]

Sir Geur,

The progress bar is goes back to 0 when copy is canceled. So you just have to put the conditions before exiting sub. Tnx!

As for the code below..I am quite hesitant to use it as after I replicate files..and click log file button using your code below since it only opens an empty file..but does not write the copied files on the Log.text

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

At the end of my replicate button code I have already indicated that a log file should be printed. I put this after files are successfully replicated. I will by default print and save the Log file at c:\Log.txt

            '§ 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
 
 

I would only need the filenames ( a new or replaced file does not matter ). Is there also a way to indicate the total number of files being copied? I assume by couting the lines in the saved file? How?

[Guido Geurs]

The total of different files to copy= TextFiles.Count-1 (-1 for the original textbox with index= 0)
The total of copyed files is already calculated for the progress bar= COPYTOTAL
In:

   For COPIESidx = 1 To TextFiles.Count - 1
      COPYTOTAL = COPYTOTAL + Val(CopyTimes(COPIESidx))
   Next

[blurryanthem]

Hello Sir Geur,

It's just now that I have noticed that hung up. There seems to be a problem when copying large number of copies per chosen file. The tool seems to hung up and does not anymore show all the progress and then after a while immediately goes to 100%.

I'm unsure if this can handle thousand of copies?
Any help?

Thank You!

[blurryanthem]

Sir Geur,

I also want to understand your code below as when clicked, it seems to ask the user to create Log file. And then when confirmed, it creates an empty Log file. It doesn't write the filenames to the Log.txt. What does it really do? Just open and create an empty Log.txt?

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

I have indicated in the last lines of my code at Replicate button this:

            '§ 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
 

[Guido Geurs]

Q1 : maybe there are to much copies at the same time.
Is the problem solved if You enter the "Doevents" after the copy command like this:

.....
         If MESSAGE = vbNo Then GoTo NextFile
         FileCopy TextFiles(STARTFILEidx), SaveTo.Text & "\" & FILETO
         DoEvents
         '§ add filename for printing log
         If FILEEXIST Then
.....
 

Q2: My code opens notepad to a logfile I make in the destination folder (SaveTo.Text).

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

If Your Logfile is = "c:\Log.txt" (there is no logfile created by Your code in the copy-to folder) then the code must be:

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

[blurryanthem]

Hello Sir Geur,

I just noticed that a Run time error '75', Path/File access error is being thrown when I am trying to replicate/copy files into an empty/formatted external drive( ex. usb flash drive)

But when the same flash drive has at least a file in it, then replicate/copy files to the drive using the tool...no error is thrown and normal copy process is performed.

When the error "75" occured, it seemed to point at this line:

If Dir$(PATHpart, vbDirectory) = "" Then MkDir (PATHpart) '§ create folders

Any idea why?
Thanks
Emily

[Guido Geurs]

The previous code checks only on Folders.
If you want to copy to the root, the code "Dir$(PATHpart, vbDirectory)" gives an error because it's a root and not a vbDirectory !
If it's an existing root, go directly to the copy code.
I have changed it to check drive, root and folders (see attachment).

[blurryanthem]

I have added the code to my program , but it only seems to resolve the copying to the root drive ( ex. f:)

But not when another folder is created within that drive ( ex. f:\new ) - the same error is thrown.

[blurryanthem]

Also I have trouble on the copy process, wherein If i need to just "replace all" and not anymore mind the individual checking of existing file.

Like I am thinking that after checking if a file exist there should be options to:

1. Replace All
a. If yes, then it should proceed to start copy and overwrite all existing files
b. If no, then maybe prompt the options to:
* Replace only this file?
* Skip this file?
* Cancel

Does this makes sense?

[blurryanthem]

Sir Geur,

Can you help me on these options instead?

If Dir(SaveTo.Text & "\" & FILETO) <> "" Then
                MESSAGE = MsgBox("The file " & FILETO & " already exist!." & vbNewLine & _
                     "Replace existing files?" & vbNewLine & _
                    vbNewLine & _
                     "Yes to All. [Yes]" & vbNewLine & _
                     "This file only. [No]" & vbNewLine & _
                    "Cancel copy process. [Cancel]", vbYesNoCancel)
                FILEEXIST = True
                End If
 

Or any way where I could have options like:
- yes to all
- this file only
- skip this file
- cancel copy

any help?

Thanks!

[Guido Geurs]

The code=

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

checks if a volumename exist for the drive!
If it's an USB stick without a name then the code exit the sub.
I have changed the check with a FileSystemObject because you can't check it with Dir$ ( !! add the reference : "Microsoft Scripting Runtime" to the project if you want to use a FSO).
The standard msgbox can't be adapted.
For a custom Msgbox: you have to create your own! (see attachment)

[blurryanthem]

Sir Geur,

I just tried the code and it worked only when saving files into the root of a flash drive/memory device.
However, if the root drive is empty and you try to create a folder to that flash drive for saving it throws out an error instead. But if the root drive of a flash drive has something ..then creation of a folder and saving of files innto that folder is okay.

I also ran into another problem in my whole copy process ;( It really worries me alot now... my copy process seems to not work properly already after I tried the cases.

Option Explicit
Dim fselectIDX As Integer
Dim LOGTEXT As String
 
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
 
Private Sub ComShowLog_Click()
Dim NOTEPADSHELL As Double
   NOTEPADSHELL = Shell("Notepad " & SaveTo.Text & "\Log.txt", vbNormalFocus)
End Sub
 
'§ Loads Form
Private Sub Form_Load()
    Picture1.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
   ShapeProgress.Width = 0
End Sub
 
'§ Opens Windows Explorer
Private Sub OpenWEBtn_Click()
    Dim Det As Long
    Det = Shell("explorer.exe /e, C:\", vbNormalFocus)
End Sub
 
'§ Selects Drive
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
 
'§ Selects Directory within selected Drive
Private Sub Dir1_Change()
SaveTo.Text = Dir1.Path
End Sub
 
'§ Compares FrameFix vs FrameSlide height
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
 
'§ Handles the vertical scroll bar
Private Sub VScrollFiles_Change()
FrameSlide.Top = -VScrollFiles.Value * 10
End Sub
 
'§ Handles the dragged dropped files and loads them into the Text1 texbox array
Private Sub Picture1_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 = 1
            .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
 
'§ Specifies a numeric entry only in the CopyTimes textbox
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
 
'§ Deletes individual selected file
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
 
'§ Deletes individual selected file
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
 
'§ Handles the whole COPY/REPLICATION process
Private Sub ReplicateBtn_Click()
Dim FSO As FileSystemObject
Dim DRIVEEXIST As Boolean
Dim NEWPATH As String
 
'§ Check Folder from SaveTo
Dim ARRFOLDERS() As String
Dim ARRFOLDERSidx As Integer
Dim ARRFOLDERScount As Integer
Dim PATHpart As String
 
'§ count number of copies
Dim COPIESidx As Integer
Dim COPYPROGRESS As Integer
Dim COPYTOTAL As Integer
 
'§ Loop through 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
Dim FILEEXIST As Boolean
 
'§ Loop through files to print
Dim hFile As Long
Dim sFilename As String
 
 
'§ General
Dim MESSAGE As Variant
Dim MSGFORM As New Form_MSG_FileExist
Dim MSGWHATTODO As String
    Set FSO = CreateObject("scripting.filesystemobject")
 
'§ check if Files to copy <> 0
   If Text1.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
 
'§ Check destination drive from SaveTo
If SaveTo.Text = "" Then
      MsgBox ("Please specify a copy destination.")
      Exit Sub
End If
 
'§ check if drive exist
   DRIVEEXIST = FSO.DriveExists(SaveTo.Text)
   If Not DRIVEEXIST And Len(SaveTo.Text) = 3 Then
      MsgBox "There is no Drive with this name !"
      Exit Sub
   End If
 
'§ If drive don't exist: exit
   If Dir$(SaveTo.Text, vbVolume) = "" Then
      MsgBox "The drive don't exist !"
      Exit Sub
   End If
 
'§ path= root: copy
   If Len(SaveTo.Text) = 3 Then GoTo Start_Copy
 
'§ Check Folder from SaveTo: create new path?
   If Dir$(SaveTo.Text, vbDirectory) = "" Then
      MESSAGE = MsgBox("The folder " & SaveTo.Text & " doesn't exist." & _
                     vbNewLine & "Create the folder ?", vbYesNo)
      If MESSAGE = vbYes Then
         ARRFOLDERS = Split(SaveTo.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
 
Start_Copy:
'§ count number of copies
   COPYTOTAL = 0
   For COPIESidx = 1 To Text1.Count - 1
      COPYTOTAL = COPYTOTAL + Val(CopyTimes(COPIESidx))
   Next
 
'§ Loop through files to copy
   COPYPROGRESS = 0
   LabelProgress.Caption = "Copying"
   LOGTEXT = ""
 
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
         FILEEXIST = False
         If Dir(SaveTo.Text & "\" & FILETO, vbArchive) <> "" And _
               MSGWHATTODO <> "Yes to All" Then
            MSGWHATTODO = MSGFORM.ShowDialog(FILETO, Me)
         Else
            GoTo Copy_File
         End If
         Me.Refresh
         Select Case MSGWHATTODO
         Case "File Only"
            GoTo Copy_File
         Case "Skip this file"
            GoTo NextFile
         Case "Cancel"
            Exit Sub
         End Select
 
Copy_File:
         FileCopy Text1(STARTFILEidx), SaveTo.Text & "\" & FILETO
         DoEvents
         '§ add filename for printing log
         If FILEEXIST Then
            LOGTEXT = LOGTEXT & FILETO & ": Replaced" & vbNewLine
         Else
            LOGTEXT = LOGTEXT & FILETO & ": New" & vbNewLine
         End If
NextFile:
         COPYPROGRESS = COPYPROGRESS + 1
         LabelProgress.Caption = "Progress : " & COPYPROGRESS & "/" & _
                              COPYTOTAL & " copied"
         ShapeProgress.Width = (COPYPROGRESS / COPYTOTAL) * ShapeProgressBack.Width
      Next
 
FileError:
            Select Case Err.Number
            Case 61
            MsgBox ("Destination drive is full.")
            Case 70
            MsgBox ("Permission Denied. The Memory Device is write protected.")
            End Select
   Next
   LabelProgress.Caption = "Done"
   ShapeProgress.Width = 0
 
End Sub
 
'§ Deletes all files in the list
Private Sub ClearBtn_Click()
Dim i As Integer
 
    If Text1.Count = 1 Then
        MsgBox ("There are no files to delete.")
    Else
        For i = 1 To Text1.UBound
            Unload Text1(i)
            Unload CopyTimes(i)
        Next
        Call Calc_FrameSlide_Height
     End If
End Sub
 
'§ Opens Saved Log file
Private Sub LogBtn_Click()
    Dim LogFile As String
    Dim NOTEPADSHELL As Double
 
    If Text1.Count = 1 Then
       MsgBox "There are no copied files." & vbNewLine & _
                "Log not created."
    Else
    LogFile = "notepad c:\Log.txt"
    Shell LogFile
    'NOTEPADSHELL = Shell("Notepad " & SaveTo.Text & "\Log.txt", vbNormalFocus)
    End If
End Sub