Kopieren einer Datei von einem Ordner in einen anderen mit vbscripting

Question

Kann mir jemand sagen, wie man eine Datei von einem Ordner in einen anderen mit Vbscripting kopiert? Ich hatte versucht, diese unten ein aus den Informationen im Internet.

dim filesys

set filesys=CreateObject("Scripting.FileSystemObject")

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

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

Wenn ich diese ausführe, erhalte ich die Meldung, dass die Genehmigung verweigert wird.

Answer 1

Versuchen Sie dies. Es wird geprüft, ob die Datei im Zielordner bereits vorhanden ist, und wenn ja, wird geprüft, ob die Datei schreibgeschützt ist. Wenn die Datei schreibgeschützt ist, wird sie in schreibgeschützt umgewandelt, ersetzt die Datei und macht sie wieder schreibgeschützt.

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

Für das Kopieren einer einzelnen Datei, hier der Code:

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 3

Hier ist eine Antwort, die auf der Antwort von Tester101 basiert (und meiner Meinung nach eine Verbesserung darstellt), ausgedrückt als Unterprogramm, mit der CopyFile-Zeile nur einmal statt dreimal, und darauf vorbereitet, den Dateinamen zu ändern, während die Kopie erstellt wird (kein fest kodiertes Zielverzeichnis). Ich habe auch festgestellt, dass ich die Zieldatei vor dem Kopieren löschen musste, damit das funktioniert, aber das könnte ein Problem von Windows 7 sein. Die WScript.Echo-Anweisungen sind, weil ich keinen Debugger hatte und können natürlich entfernt werden, wenn gewünscht.

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 4

Ich habe gerade meinen fertigen Code für ein ähnliches Projekt veröffentlicht. Es kopiert Dateien bestimmter Erweiterungen in meinem Code seine pdf tif und tiff Sie können sie zu ändern, was Sie kopiert oder löschen Sie die if-Anweisungen, wenn Sie nur 1 oder 2 Arten benötigen. Wenn eine Datei erstellt oder geändert wird, erhält sie das Archiv-Attribut. Dieser Code sucht auch nach diesem Attribut und kopiert es nur, wenn es vorhanden ist, und entfernt es dann, nachdem es kopiert wurde, so dass Sie keine unbenötigten Dateien kopieren. Es hat auch ein Log-Setup in ihm, so dass Sie ein Protokoll sehen, welche Zeit und Tag evetrything wurde von der letzten Zeit, die Sie das Skript ausgeführt haben übertragen. Hoffentlich hilft es! Der Link lautet Fehler: Objekt erforderlich; 'objDIR' Code: 800A01A8

Answer 5

Bitte finden Sie den untenstehenden Code:

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