使用 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

复制单个文件，代码如下：

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

这是一个答案，基于（我认为是改进）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 4

刚刚发布了我完成的类似项目的代码。它在我的代码中复制某些扩展名的文件，它的 pdf tif 和 tiff 您可以将它们更改为您想要复制的任何内容，或者如果您只需要 1 或 2 种类型，则删除 if 语句。创建或修改文件时，它会获取存档属性，此代码还会查找该属性，并且仅在存在时复制它，然后在复制后将其删除，这样您就不会复制不需要的文件。它还有一个日志设置，这样您就可以看到上次运行脚本时传输的时间和日期的日志。希望能帮助到你！ 链接是Error: Object Required; 'objDIR' Code: 800A01A8

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