Sao chép tệp từ thư mục này sang thư mục khác bằng cách sử dụng vbscripting

Question

Bất kỳ ai cũng có thể cho tôi biết cách sao chép tệp từ một thư mục này sang thư mục khác bằng cách sử dụng vbscripting Tôi đã thử điều này dưới đây từ thông tin cung cấp trên internet.

dim filesys 

set filesys=CreateObject("Scripting.FileSystemObject") 

If filesys.FileExists("c:\sourcefolder\anyfile.txt") Then 

filesys.CopyFile "c:\sourcefolder\anyfile.txt", "c:\destfolder\" 

Khi tôi thực hiện điều này, tôi nhận được sự cho phép bị từ chối.

Answer 1

Hãy thử điều này. Nó sẽ kiểm tra xem tập tin đã tồn tại trong thư mục đích chưa, và nếu nó sẽ kiểm tra xem tệp có chỉ đọc hay không. Nếu tập tin là chỉ đọc nó sẽ thay đổi nó để đọc-ghi, thay thế các tập tin, và làm cho nó chỉ đọc một lần nữa.

Const DestinationFile = "c:\destfolder\anyfile.txt" 
Const SourceFile = "c:\sourcefolder\anyfile.txt" 

Set fso = CreateObject("Scripting.FileSystemObject") 
    'Check to see if the file already exists in the destination folder 
    If fso.FileExists(DestinationFile) Then 
     'Check to see if the file is read-only 
     If Not fso.GetFile(DestinationFile).Attributes And 1 Then 
      'The file exists and is not read-only. Safe to replace the file. 
      fso.CopyFile SourceFile, "C:\destfolder\", True 
     Else 
      'The file exists and is read-only. 
      'Remove the read-only attribute 
      fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes - 1 
      'Replace the file 
      fso.CopyFile SourceFile, "C:\destfolder\", True 
      'Reapply the read-only attribute 
      fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes + 1 
     End If 
    Else 
     'The file does not exist in the destination folder. Safe to copy file to this folder. 
     fso.CopyFile SourceFile, "C:\destfolder\", True 
    End If 
Set fso = Nothing 

Answer 2

Dưới đây là một câu trả lời, dựa trên (và tôi nghĩ rằng một sự cải tiến trên) Tester101 của câu trả lời, thể hiện dưới dạng một chương trình con, với dòng CopyFile một lần thay vì ba lần, và chuẩn bị sẵn sàng để xử lý thay đổi tên tập tin như bản sao được tạo (không có thư mục đích được mã hóa cứng). Tôi cũng tìm thấy tôi đã phải xóa các tập tin mục tiêu trước khi sao chép để có được điều này để làm việc, nhưng đó có thể là một điều Windows 7. Các câu lệnh WScript.Echo là bởi vì tôi không có một trình gỡ lỗi và dĩ nhiên có thể được gỡ bỏ nếu muốn.

Sub CopyFile(SourceFile, DestinationFile) 

    Set fso = CreateObject("Scripting.FileSystemObject") 

    'Check to see if the file already exists in the destination folder 
    Dim wasReadOnly 
    wasReadOnly = False 
    If fso.FileExists(DestinationFile) Then 
     'Check to see if the file is read-only 
     If fso.GetFile(DestinationFile).Attributes And 1 Then 
      'The file exists and is read-only. 
      WScript.Echo "Removing the read-only attribute" 
      'Remove the read-only attribute 
      fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes - 1 
      wasReadOnly = True 
     End If 

     WScript.Echo "Deleting the file" 
     fso.DeleteFile DestinationFile, True 
    End If 

    'Copy the file 
    WScript.Echo "Copying " & SourceFile & " to " & DestinationFile 
    fso.CopyFile SourceFile, DestinationFile, True 

    If wasReadOnly Then 
     'Reapply the read-only attribute 
     fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes + 1 
    End If 

    Set fso = Nothing 

End Sub 

Answer 3

Chỉ cần đăng mã đã hoàn thành của tôi cho một dự án tương tự. Nó sao chép các tập tin của một số phần mở rộng trong mã của tôi pdf tif và tiff của bạn, bạn có thể thay đổi chúng thành bất cứ điều gì bạn muốn sao chép hoặc xóa các báo cáo nếu bạn chỉ cần 1 hoặc 2 loại. Khi một tập tin được tạo ra hoặc sửa đổi nó được các thuộc tính lưu trữ mã này cũng tìm thuộc tính đó và chỉ sao chép nó nếu nó tồn tại và sau đó loại bỏ nó sau khi sao chép của nó, do đó bạn không sao chép các tập tin không cần thiết. Nó cũng có một thiết lập đăng nhập trong nó để bạn sẽ thấy một nhật ký về thời gian và ngày evetrything được chuyển từ lần cuối cùng bạn chạy kịch bản. Hy vọng nó giúp! liên kết là Error: Object Required; 'objDIR' Code: 800A01A8

Answer 4

Đối với việc sao chép các tập tin duy nhất, đây là mã:

Function CopyFiles(FiletoCopy,DestinationFolder) 
    Dim fso 
       Dim Filepath,WarFileLocation 
       Set fso = CreateObject("Scripting.FileSystemObject") 
       If Right(DestinationFolder,1) <>"\"Then 
        DestinationFolder=DestinationFolder&"\" 
       End If 
    fso.CopyFile FiletoCopy,DestinationFolder,True 
       FiletoCopy = Split(FiletoCopy,"\") 

End Function 

Answer 5

Hãy tìm mã dưới đây:

If ComboBox21.Value = "Delimited file" Then 
    'Const txtFldrPath As String = "C:\Users\513090.CTS\Desktop\MACRO"  'Change to folder path containing text files 
    Dim myValue2 As String 
    myValue2 = ComboBox22.Value 
    Dim txtFldrPath As Variant 
    txtFldrPath = InputBox("Give the file path") 
    'Dim CurrentFile As String: CurrentFile = Dir(txtFldrPath & "\" & "LL.txt") 
    Dim strLine() As String 
    Dim LineIndex As Long 
    Dim myValue As Variant 
    On Error GoTo Errhandler 
    myValue = InputBox("Give the DELIMITER") 

    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 
    While txtFldrPath <> vbNullString 
     LineIndex = 0 
     Close #1 
     'Open txtFldrPath & "\" & CurrentFile For Input As #1 
     Open txtFldrPath For Input As #1 
     While Not EOF(1) 
      LineIndex = LineIndex + 1 
      ReDim Preserve strLine(1 To LineIndex) 
      Line Input #1, strLine(LineIndex) 
     Wend 
     Close #1 

     With ActiveWorkbook.Sheets(myValue2).Range("A1").Resize(LineIndex, 1) 
      .Value = WorksheetFunction.Transpose(strLine) 
      .TextToColumns Other:=True, OtherChar:=myValue 
     End With 

     'ActiveSheet.UsedRange.EntireColumn.AutoFit 
     'ActiveSheet.Copy 
     'ActiveWorkbook.SaveAs xlsFldrPath & "\" & Replace(CurrentFile, ".txt", ".xls"), xlNormal 
     'ActiveWorkbook.Close False 
     ' ActiveSheet.UsedRange.ClearContents 

     CurrentFile = Dir 
    Wend 
    Application.DisplayAlerts = True 
    Application.ScreenUpdating = True 

End If