Скопируйте файл из одной папки в другую с помощью vbscripting

Question

Может кто-нибудь скажет мне, как скопировать файл из одной папки в другую, используя vbscripting Я пробовал это ниже один из информации, предоставляемой в Интернете.

dim filesys 

set filesys=CreateObject("Scripting.FileSystemObject") 

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

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

Когда я выполняю этот, я получаю, что разрешение отклонено.

Answer 1

Попробуйте это. Он проверит, существует ли файл в папке назначения, и если он будет проверять, доступен ли файл только для чтения. Если файл доступен только для чтения, он изменит его на чтение-запись, заменит файл и снова сделает его доступным только для чтения.

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

Вот ответ, основанный на (и я думаю, что улучшение по сравнению) ответ Tester101, выраженный в виде подпрограммы, с CopyFile линии один раз, а не в три раза, и готов обрабатывать изменения имени файла в качестве копии (нет жестко заданного каталога назначения). Я также обнаружил, что перед копированием мне пришлось удалить целевой файл, чтобы заставить его работать, но это может быть Windows 7. Операторы WScript.Echo - это потому, что у меня не было отладчика, и, конечно, можно удалить его.

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

Только что опубликовал мой готовый код для аналогичного проекта. Он копирует файлы определенных расширений в моем коде в формате pdf tif и tiff, вы можете изменить их на все, что вы хотите скопировать или удалить операторы if, если вам нужны только 1 или 2 типа. Когда файл создается или модифицируется, он получает атрибут архива, этот код также ищет этот атрибут и только копирует его, если он существует, а затем удаляет его после его копирования, поэтому вы не копируете ненужные файлы. В нем также есть настройка журнала, так что вы увидите журнал того, что время и день evetrything было перенесено с момента последнего запуска скрипта. Надеюсь, поможет! ссылка является Error: Object Required; 'objDIR' Code: 800A01A8

Answer 4

Для копирования одного файла, вот код:

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

Пожалуйста, найдите следующий код:

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