Скопируйте файл из одной папки в другую, используя 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

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

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 4

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

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

Answer 5

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