locked
Copy File RRS feed

  • Question

  • I was try copy the source to destination file, It' works sucessfully. Only the file still in using/ running, unable copy. Does anyone have idea to excluding or including file in copy?

    The source as below.

    Form1 - 1

    Option Explicit

    Dim mylog As New FileSystemObject

    Dim createlog As TextStream

    Private Sub Form_Load()

    'This example copy all files between certain dates from FromPath to ToPath.

    'You can also use this to copy the files from the last ? days

    'If Fdate >= Date - 30 Then

    'Note: If the files in ToPath already exist it will overwrite

    'existing files in this folder

    Dim fso As Object

    Dim FromPath As String

    Dim ToPath As String

    Dim Fdate As Date

    Dim FileInFromFolder As Object

    'only copy inside calib folder

    'send to PC

    'FromPath = "\\pena-dsk-208\ssxray04\5dx_Daily_Backup\Test\calib" '<< Change

    'ToPath = "\\wpend02105\5dx\r85\calib" '<< Change

    'send to server

    FromPath = "\\5dxs5000\5dx\r85\calib " '<< Change

    ToPath = "\\pena-dsk-208\ssxray04\5dx_Daily_Backup\5dx3\calib" '<< Change

    If Right(FromPath, 1) <> "\" Then

    FromPath = FromPath & "\"

    End If

    If Right(ToPath, 1) <> "\" Then

    ToPath = ToPath & "\"

    End If

    Set fso = CreateObject("scripting.filesystemobject")

    If fso.FolderExists(FromPath) = False Then

    MsgBox FromPath & " doesn't exist"

    Exit Sub

    End If

    If fso.FolderExists(ToPath) = False Then

    MsgBox ToPath & " doesn't exist"

    Exit Sub

    End If

    For Each FileInFromFolder In fso.GetFolder(FromPath).Files

    Fdate = Int(FileInFromFolder.DateLastModified)

    'Copy files from 1-Oct-2006 to 1-Nov-2006

    If Fdate >= DateSerial(2006, 10, 1) And Fdate <= DateSerial(2011, 5, 31) Then

    FileInFromFolder.Copy ToPath

    End If

    Next FileInFromFolder

    'Don't want message box pop up

    'MsgBox "You can find the files from " & FromPath & " in " & ToPath

    'This example copy all files and subfolders from FromPath to ToPath.

    'Note: If ToPath already exist it will overwrite existing files in this folder

    'if ToPath not exist it will be made for you.

    'Dim FSO As Object

    'Dim FromPath As String

    'Dim ToPath As String

    'Dim Fdate As Date

    'Dim FileInFromFolder As Object

    'able to create folder to u without folder

    'send to server

    FromPath = "\\5dxs5000\5dx\r85\config\license" '<< Change

    ToPath = "\\pena-dsk-208\ssxray04\5dx_Daily_Backup\5dx3\license" '<< Change

    Form1 - 2

    'send to PC

    'FromPath = "\\pena-dsk-208\ssxray04\5dx_Daily_Backup\Test\license" '<< Change

    'ToPath = "\\wpend02105\5dx\r85\config\license" '<< Change

    'FromPath = "C:\AS" '<< Change

    'ToPath = "C:\Test1" '<< Change

    'If you want to create a backup of your folder every time you run this macro

    'you can create a unique folder with a Date/Time stamp.

    'ToPath = "C:\Users\Ron\" & Format(Now, "yyyy-mm-dd h-mm-ss")

    If Right(FromPath, 1) = "\" Then

    FromPath = Left(FromPath, Len(FromPath) - 1)

    End If

    If Right(ToPath, 1) = "\" Then

    ToPath = Left(ToPath, Len(ToPath) - 1)

    End If

    Set fso = CreateObject("scripting.filesystemobject")

    If fso.FolderExists(FromPath) = False Then

    MsgBox FromPath & " doesn't exist"

    Exit Sub

    End If

    fso.CopyFolder Source:=FromPath, Destination:=ToPath

    'MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath

    'copy ndf file

    'This example copy all files and subfolders from FromPath to ToPath.

    'Note: If ToPath already exist it will overwrite existing files in this folder

    'if ToPath not exist it will be made for you.

    'Dim FSO As Object

    'Dim FromPath As String

    'Dim ToPath As String

    'Dim Fdate As Date

    'Dim FileInFromFolder As Object

    'able to create folder to u without folder

    'send to server

    'FromPath = "C:\5dx\r85\config\license" '<< Change

    'ToPath = "\\pena-dsk-208\ssxray04\5dx_Daily_Backup\Test\license" '<< Change

    'send ndf folder

    FromPath = "\\5dxs5000\5dx\ndf" '<< Change

    ToPath = "\\pena-dsk-208\ssxray04\5dx_Daily_Backup\5dx3\ndf" '<< Change

    'FromPath = "C:\AS" '<< Change

    'ToPath = "C:\Test1" '<< Change

    'If you want to create a backup of your folder every time you run this macro

    'you can create a unique folder with a Date/Time stamp.

    'ToPath = "C:\Users\Ron\" & Format(Now, "yyyy-mm-dd h-mm-ss")

    If Right(FromPath, 1) = "\" Then

    FromPath = Left(FromPath, Len(FromPath) - 1)

    End If

    If Right(ToPath, 1) = "\" Then

    ToPath = Left(ToPath, Len(ToPath) - 1)

    End If

    Set fso = CreateObject("scripting.filesystemobject")

    If fso.FolderExists(FromPath) = False Then

    MsgBox FromPath & " doesn't exist"

    Exit Sub

    End If

    Form1 - 3

    fso.CopyFolder Source:=FromPath, Destination:=ToPath

    'MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath

    'copy rtf file

    'This example copy all files and subfolders from FromPath to ToPath.

    'Note: If ToPath already exist it will overwrite existing files in this folder

    'if ToPath not exist it will be made for you.

    'Dim FSO As Object

    'Dim FromPath As String

    'Dim ToPath As String

    'Dim Fdate As Date

    'Dim FileInFromFolder As Object

    'able to create folder to u without folder

    'send to server

    'FromPath = "C:\5dx\r85\config\license" '<< Change

    'ToPath = "\\pena-dsk-208\ssxray04\5dx_Daily_Backup\Test\license" '<< Change

    'send rtf folder

    FromPath = "\\5dxs5000\5dx\rtf" '<< Change

    ToPath = "\\pena-dsk-208\ssxray04\5dx_Daily_Backup\5dx3\rtf" '<< Change

    'FromPath = "C:\AS" '<< Change

    'ToPath = "C:\Test1" '<< Change

    'If you want to create a backup of your folder every time you run this macro

    'you can create a unique folder with a Date/Time stamp.

    'ToPath = "C:\Users\Ron\" & Format(Now, "yyyy-mm-dd h-mm-ss")

    If Right(FromPath, 1) = "\" Then

    FromPath = Left(FromPath, Len(FromPath) - 1)

    End If

    If Right(ToPath, 1) = "\" Then

    ToPath = Left(ToPath, Len(ToPath) - 1)

    End If

    Set fso = CreateObject("scripting.filesystemobject")

    If fso.FolderExists(FromPath) = False Then

    MsgBox FromPath & " doesn't exist"

    Exit Sub

    End If

    fso.CopyFolder Source:=FromPath, Destination:=ToPath

    'MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath

    'copy panel file

    'This example copy all files and subfolders from FromPath to ToPath.

    'Note: If ToPath already exist it will overwrite existing files in this folder

    'if ToPath not exist it will be made for you.

    'Dim FSO As Object

    'Dim FromPath As String

    'Dim ToPath As String

    'Dim Fdate As Date

    'Dim FileInFromFolder As Object

    'able to create folder to u without folder

    'send to server

    'FromPath = "C:\5dx\r85\config\license" '<< Change

    'ToPath = "\\pena-dsk-208\ssxray04\5dx_Daily_Backup\Test\license" '<< Change

    'send panels

    FromPath = "\\5dxs5000\5dx\panels" '<< Change

    ToPath = "\\pena-dsk-208\ssxray04\5dx_Daily_Backup\5dx3\panels" '<< Change

    Form1 - 4

    'send panels

    'FromPath = "\\pena-dsk-208\ssxray04\5dx_Daily_Backup\Test\panels" '<< Change

    'ToPath = "\\wpend02105\5dx\panels" '<< Change

    'FromPath = "C:\AS" '<< Change

    'ToPath = "C:\Test1" '<< Change

    'If you want to create a backup of your folder every time you run this macro

    'you can create a unique folder with a Date/Time stamp.

    'ToPath = "C:\Users\Ron\" & Format(Now, "yyyy-mm-dd h-mm-ss")

    If Right(FromPath, 1) = "\" Then

    FromPath = Left(FromPath, Len(FromPath) - 1)

    End If

    If Right(ToPath, 1) = "\" Then

    ToPath = Left(ToPath, Len(ToPath) - 1)

    End If

    Set fso = CreateObject("scripting.filesystemobject")

    If fso.FolderExists(FromPath) = False Then

    MsgBox FromPath & " doesn't exist"

    Exit Sub

    End If

    fso.CopyFolder Source:=FromPath, Destination:=ToPath

    'MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath

    'Log File Locate

    If mylog.FileExists("\\pena-dsk-208\ssxray04\5dx_Daily_Backup\5dx3\log\mylog.log") = False Then

    Set createlog = mylog.CreateTextFile("\\pena-dsk-208\ssxray04\5dx_Daily_Backup\5dx3\log\mylog.log", Fa

    lse)

    Else

    Set createlog = mylog.OpenTextFile("\\pena-dsk-208\ssxray04\5dx_Daily_Backup\5dx3\log\mylog.log", ForA

    ppending, False, TristateUseDefault)

    End If

    'create log file

    createlog.WriteLine (Date & " " & Time & " Restore Complete, any enquiry pls. contact:")

    vbCrLf 'Log File Locate

    End Sub

    • Moved by Mark Liu-lxf Friday, October 21, 2011 3:03 AM VB6 (From:Visual Basic General)
    Wednesday, October 19, 2011 9:25 AM

Answers

All replies