by Martin Anbu Selvan (18 Submissions)
Category: Files/File Controls/Input/Output
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sun 2nd May 2004
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Copy file from any location to another.Even from CDROM to your system folder.
API Declarations
Public IFileName As String
Public OFileName As String
Public Status As Boolean
VBcoders
Private Sub cmdCopy_Click()
If cmdCopy.Caption = "Copy" Then
Status = True
cmdCopy.Caption = "S&top"
CopyModule.FileCopy
Else
cmdCopy.Caption = "Copy"
Status = False
End If
End Sub
Private Sub cmdExit_Click()
Dim VipAsk As Byte
VipAsk = MsgBox("Do You Really Want To Exit Wipin's 'FILECOPY'.", vbYesNo + vbExclamation, "Wipin")
If VipAsk = 6 Then End
End Sub
Private Sub Del_Click()
Dim VipCheq As Byte
VipCheq = MsgBox("Do You Really Want To Delete The Selected Folder.", vbYesNo + vbExclamation)
If VipCheq = 6 Then RmDir (Dir2.Path)
Dir2.Refresh
End Sub
Private Sub DelFile_Click()
On Error GoTo VipErr
Kill (GetSource)
VipFile.Refresh
VipErr:
If Err Then MsgBox "First Choose The File To Be Deleted.", vbCritical, "Wipin"
End Sub
Private Sub Dir2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
PopupMenu Vipin
End If
End Sub
Private Sub drv2_Change()
On Error GoTo VipErr
Dir2.Path = drv2.Drive
VipErr:
If Err.Number = 68 Then MsgBox "Device Unavailable.", vbInformation
End Sub
Private Sub Form_Load()
drv2.Drive = "c:"
VipDrv.Drive = "c:"
End Sub
Private Sub MD_Click()
Dim VipdirName As String
VipdirName = InputBox("Enter the Desired Folder's Name: ", "Folder Name", "VipFolder")
MkDir (Dir2.Path + "\" + VipdirName)
End Sub
Private Sub VipDir_Change()
On Error GoTo VipErr
VipFile.Path = VipDir.Path
VipErr:
If Err.Number = 68 Then MsgBox "Device Unavailable."
End Sub
Private Sub VipDrv_Change()
On Error GoTo VipErr
VipDir.Path = VipDrv.Drive
VipErr:
If Err.Number = 68 Then MsgBox "Device Unavailable.", vbInformation
End Sub
Private Sub VipFile_Click()
txtDest = VipFile.FileName
IFileName = MyForm.VipFile.Path + "\" + MyForm.VipFile.FileName
lblBytes.Caption = "Source File Size: " & Round((FileLen(IFileName) / 1024) / 1024, 2) & " MB"
End Sub
Private Sub VipFile_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then PopupMenu VipSrc
End Sub
'module:
Public IFileName As String
Public OFileName As String
Public Status As Boolean
Public Sub FileCopy()
Dim Progress As Long
Dim InputFile As Integer
Dim OutputFile As Integer
Dim FileSize As Long
Dim f_size As String
Dim VipCheq As Byte
On Error GoTo VipCorrupted
InputFile = FreeFile
IFileName = GetSource 'Gets the source file name
OFileName = GetDestination 'gets the destination file name
If MyForm.txtDest = "" Then
MsgBox "No Destination file name is specified." + vbCrLf + "Please give a file name to be created.", vbCritical, "Wipin"
MyForm.txtDest.SetFocus
MyForm.cmdCopy.Caption = "Copy"
Exit Sub
End If
If Not CheqSrcDestErr Then Exit Sub
If Dir(OFileName) = MyForm.txtDest Then
VipCheq = MsgBox("A file naming '" + MyForm.txtDest + "' already exists." + vbCrLf + "Do You Want to OverWrite the File.", vbCritical + vbYesNo, "Wipin")
If VipCheq <> 6 Then
MyForm.cmdCopy.Caption = "Copy"
Exit Sub
End If
End If
Open IFileName For Binary As InputFile 'opens a file as a Source
OutputFile = FreeFile
Open OFileName For Binary Access Write Lock Read As OutputFile 'opens a file for putting the data read from Source
f_size = String(1048576, " ") 'How much data has to be read
While EOF(InputFile) <> True And Status = True
If FileLen(IFileName) - Loc(OutputFile) < 1048576 Then f_size = String(1024, " ")
On Error Resume Next
Get #InputFile, , f_size
Put #OutputFile, , f_size
Progress = Round((Loc(OutputFile) / FileLen(IFileName) * 100), 2)
If Progress > 100 Then Progress = 100
MyForm.VipBar.Value = Progress
MyForm.lblCopied.Caption = Round(Loc(OutputFile) / 1024 / 1024, 2) & " MB"
MyForm.lblInputLoc.Caption = Loc(InputFile)
DoEvents
VipCorrupted:
If Err.Number = 75 Then
'MsgBox Err.Number
Seek #InputFile, (Loc(InputFile) + 1048576)
End If
Wend
Reset
If Status = True Then
MsgBox "File Copy Completed.", vbInformation
Else
Kill MyForm.Dir2.Path + "\" + MyForm.txtDest
End If
MyForm.cmdCopy.Caption = "Copy"
MyForm.VipBar.Refresh
End Sub
Public Function GetSource() As String
If Right(MyForm.VipDir.Path, 1) <> "\" Then
GetSource = MyForm.VipFile.Path + "\" + MyForm.VipFile.FileName
Else
GetSource = MyForm.VipFile.Path + MyForm.VipFile.FileName
End If
End Function
Public Function GetDestination() As String
If Right(MyForm.Dir2.Path, 1) <> "\" Then
GetDestination = MyForm.Dir2.Path + "\" + MyForm.txtDest
Else
GetDestination = MyForm.Dir2.Path + MyForm.txtDest
End If
End Function
Private Function CheqSrcDestErr() As Boolean
CheqSrcDestErr = True
If MyForm.VipFile = Empty Or OFileName = "" Then
MsgBox "Choose Source and Destination first.", vbCritical, "Source/Dest Error."
MyForm.cmdCopy.Caption = "Copy"
CheqSrcDestErr = False
End If
End Function
No comments have been posted about Copy file from any location to another.Even from CDROM to your system folder.. Why not be the first to post a comment about Copy file from any location to another.Even from CDROM to your system folder..
