?
Solved

looking for VBcode to drag files on a window and send them to a defined place

Posted on 2003-03-25
7
Medium Priority
?
129 Views
Last Modified: 2010-04-07
hello,

i'm looking for a program where it is possible to drag and drop files on to.
and then if you press a specified button copy the files to a defined place.

there should be also a variable in it that when it starts copying
checks if the nex directory is there.
example :

r:\users\%username%\

is username does not exist mk dir.
if there is already any data in it delete it first before copying

kind regards
Bauke Plugge
Mexx Informatics
0
Comment
Question by:baukeplugge
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 3
7 Comments
 
LVL 3

Expert Comment

by:YeaYuh
ID: 8217750
Sounds like an interesting project, I will try to whip something up.
0
 

Author Comment

by:baukeplugge
ID: 8218284
hi yeayuh,

that would be great.
I hope that you can make something that we need

kind regards
Bauke Plugge
0
 

Author Comment

by:baukeplugge
ID: 8218285
hi yeayuh,

that would be great.
I hope that you can make something that we need

kind regards
Bauke Plugge
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 3

Expert Comment

by:YeaYuh
ID: 8222394
Okay I made a program that accepts files and directories to be dragged onto a window.  You can double-click the file to remove it from the window.  When you hit the button it will delete the files or sub-directories in R:\users\username\ unless a file is open then it will ignore that file or sub-directory.

It will probally be easier for me to send you the code over email.
Send me a email at YeaYuh@yahoo.com

Code

VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   4650
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4710
   LinkTopic       =   "Form1"
   OLEDropMode     =   1  'Manual
   ScaleHeight     =   4650
   ScaleWidth      =   4710
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1
      Caption         =   "Move Files to Folder"
      Height          =   495
      Left            =   960
      TabIndex        =   2
      Top             =   3480
      Width           =   2295
   End
   Begin VB.ListBox List2
      Height          =   450
      Left            =   120
      TabIndex        =   1
      Top             =   4080
      Visible         =   0   'False
      Width           =   4455
   End
   Begin VB.ListBox List1
      Height          =   2790
      Left            =   120
      OLEDropMode     =   1  'Manual
      TabIndex        =   0
      Top             =   240
      Width           =   4455
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit ' *ALWAYS* use option explicit
Dim NetDrive As String

Private Sub Command1_Click()
Dim destPath As String
Dim objFileDir As New Scripting.FileSystemObject
Dim objFileCpy As New Scripting.FileSystemObject
Dim X As Integer

destPath = NetDrive & Environ("username") & "\"

'If folder exists delete files and sub directories
If objFileDir.FolderExists(destPath) = True Then
   DeleteAllFiles (destPath)
   DeleteAllSubDirs (destPath)
Else
'Folder Doesn't exist create the folder
   objFileDir.CreateFolder (destPath)
End If

'Copies the folders/files in list to destPath
For X = List2.ListCount - 1 To 0 Step -1
   Form1.Caption = "Copying " & List1.List(X)
   On Error Resume Next
   objFileCpy.CopyFile List2.List(X), destPath, True
   If Err.Number = 53 Then
      objFileCpy.CopyFolder List2.List(X), destPath, True
   End If
   List2.RemoveItem (X)
   List1.RemoveItem (X)
Next X
Form1.Caption = "Move To Folder"
End Sub

'[Events]
  Private Sub Form_Load()
  ' Set the form caption
    Me.Caption = "Move To Folder"
    NetDrive = "R:\users\"
  End Sub

 
Private Sub List1_DblClick()
Dim SelectedFile As Integer
SelectedFile = List1.ListIndex
List1.RemoveItem (SelectedFile)
List2.RemoveItem (SelectedFile)
End Sub

Private Sub List1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lAt As Long           ' Index for files or text
    Dim sContent() As String  ' Array to hold text
    Dim OFso As New Scripting.FileSystemObject
   
   
  ' Check the format of what was dropped onto it
    If Data.GetFormat(vbCFFiles) Then
    ' File(s) from explorer or something
      For lAt = 1 To Data.Files.count
         List2.AddItem Data.Files(lAt)
         List1.AddItem (OFso.GetBaseName(Data.Files(lAt)))
      Next lAt
   End If
End Sub
Public Function DeleteAllFiles(ByVal FolderSpec As String) _
  As Boolean

'Deletes all files in folder specified
'by parameter FolderSpec.  Does not delete
'subfolders or files within subfolders

'Returns True if sucessful, false otherwise

'Requires a reference the Microsoft Scripting Runtime

'EXAMPLE: DeleteAllFiles "C:\Test"

Dim oFs As New FileSystemObject
Dim oFolder As Folder
Dim oFile As File


If oFs.FolderExists(FolderSpec) Then
    Set oFolder = oFs.GetFolder(FolderSpec)
    On Error Resume Next
    For Each oFile In oFolder.Files
        oFile.Delete True 'setting force to true
                        'deletes read-only file
    Next
    DeleteAllFiles = oFolder.Files.count = 0
End If

End Function
Public Function DeleteAllSubDirs(ByVal FolderSpec As String) As Boolean
'Deletes all sub directories in folder specified
'by parameter FolderSpec.  Does not delete
'opened files within subfolders but will delete rest of files
'and return false

'Returns True if sucessful, false otherwise

'Requires a reference the Microsoft Scripting Runtime

'EXAMPLE: DeleteAllSubDirs "C:\Test"
   
   
   Dim objFileDir As New Scripting.FileSystemObject
   Dim objFolder As Scripting.Folder
   Dim objSubFld As Scripting.Folders
   Dim objLoopFolder As Scripting.Folder
   Dim subPath As String
   
   Set objFolder = objFileDir.GetFolder(FolderSpec)
   Set objSubFld = objFolder.SubFolders
   On Error Resume Next
   For Each objLoopFolder In objSubFld
      subPath = objLoopFolder.Path
      objFileDir.GetFolder(subPath).Delete True
   Next
   
   DeleteAllSubDirs = objFolder.SubFolders.count = 0
End Function

End Code

Need to reference the Microsoft Scripting RunTime
Takes a little while when moving large files and there is no checking to see if drive has enough space to handle files.
0
 

Author Comment

by:baukeplugge
ID: 8223820
it works great.

but is it also possible to make a progress bar when copying files. and if there files to delete is it possible to get a question before deleting so the user can chose to append or start a new session ?

is it also possible to create a file if the copy is completed.
that sould be created on r:\tasks\%username%.tsk_todo
and should containt the next items:

[TASK]
TYPE=0
BASE_DIR="R:\Users\%Usersname%"
DELETE_IMAGE=2
MD5_CHECK=0
DVD=0
VOLUME_NAME=martin
ZONE1=
ZONE2=
ZONE3=
ZONE4=
ZONE5=
ZONE6=
ZONE7=
ZONE8=
ZONE9=
ZONE10=
ZONE11=
ZONE12=
ZONE13=
ZONE14=
ZONE15=
ZONE16=
ZONE17=
ZONE18=
ZONE19=
ZONE20=
FILE_OK=1

if this is possible it would be great


kind regards
0
 
LVL 3

Accepted Solution

by:
YeaYuh earned 340 total points
ID: 8224491
I can work on it this weekend.

Progress Bar:  Shouldn't be too hard to add.

You only want to ask the question once correct? So it either delete everything in the space or to keeps everything.  

Yeah I can make a file, but not really sure what some of these are supposed to be.

Not sure what Type is supposed to represent
TYPE=0

I understand this.
BASE_DIR="R:\Users\%Usersname%"

Not sure what the next 3 represent.
DELETE_IMAGE=2
MD5_CHECK=0
DVD=0  

I take this is the HD name
VOLUME_NAME=martin I take this is the HD name

Are these just supposed to be the files and directories copied.
ZONE1=
ZONE2=
ZONE3=
ZONE4=
ZONE5=
ZONE6=
ZONE7=
ZONE8=
ZONE9=
ZONE10=
ZONE11=
ZONE12=
ZONE13=
ZONE14=
ZONE15=
ZONE16=
ZONE17=
ZONE18=
ZONE19=
ZONE20=

Does this mean that the copy of all the files was succesful.
FILE_OK=1
0
 

Author Comment

by:baukeplugge
ID: 8224733
the file is a file special for an other program.
(a program that burns a cd)

so almost al the lines are not variable.
only:
BASE_DIR="R:\Users\%Usersname%"
VOLUME_NAME=%cd volume label% (would be great if there would be a question for this volume labl)

the rest is not yet active but will be if we want to print someting on the cd

kind regards
bauke
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Suggested Courses
Course of the Month11 days, 20 hours left to enroll

752 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question