baukeplugge
asked on
looking for VBcode to drag files on a window and send them to a defined place
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
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
Sounds like an interesting project, I will try to whip something up.
ASKER
hi yeayuh,
that would be great.
I hope that you can make something that we need
kind regards
Bauke Plugge
that would be great.
I hope that you can make something that we need
kind regards
Bauke Plugge
ASKER
hi yeayuh,
that would be great.
I hope that you can make something that we need
kind regards
Bauke Plugge
that would be great.
I hope that you can make something that we need
kind regards
Bauke Plugge
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(de
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.Fil
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(FolderSpe
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(Folde
Set objSubFld = objFolder.SubFolders
On Error Resume Next
For Each objLoopFolder In objSubFld
subPath = objLoopFolder.Path
objFileDir.GetFolder(subPa
Next
DeleteAllSubDirs = objFolder.SubFolders.count
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.
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(de
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.Fil
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(FolderSpe
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(Folde
Set objSubFld = objFolder.SubFolders
On Error Resume Next
For Each objLoopFolder In objSubFld
subPath = objLoopFolder.Path
objFileDir.GetFolder(subPa
Next
DeleteAllSubDirs = objFolder.SubFolders.count
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.
ASKER
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_to
and should containt the next items:
[TASK]
TYPE=0
BASE_DIR="R:\Users\%Usersn
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
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_to
and should containt the next items:
[TASK]
TYPE=0
BASE_DIR="R:\Users\%Usersn
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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\%Usersn
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
(a program that burns a cd)
so almost al the lines are not variable.
only:
BASE_DIR="R:\Users\%Usersn
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