vba - 将文件复制到现有文件夹时出错

Question

我正在编写一些代码，提示用户添加文件夹名称，然后将 CD 驱动器 (D:) 上的所有文件复制到 C:\Example\ & FolderName如果它还不存在。

代码一直有效，直到我尝试将文件复制到已经存在的文件夹然后我得到 Run-time error 70: Permission Denied .任何帮助将不胜感激。

Public Sub CopyFiles()

Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim FileExt As String
Dim FNames As String
Dim FolderName As String

FolderName = InputBox(Prompt:="Your folder name", Title:="Folder Name", default:="Folder Name here")

If Dir("C:\Example\" & FolderName & "\", vbDirectory) = "" Then
    MkDir "C:\Example\" & FolderName
Else
End If

FromPath = "D:\"
ToPath = "C:\Example\" & FolderName & "\"
FileExt = "*.flac*"

If Right(FromPath, 1) <> "\" Then
    FromPath = FromPath & "\"
End If

FNames = Dir(FromPath & FileExt)
If Len(FNames) = 0 Then
    MsgBox "No files in " & FromPath
    Exit Sub
End If

Set FSO = CreateObject("scripting.filesystemobject")

FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath

End Sub

Answer 1

问题不在于该文件夹存在。问题是您正在尝试复制文件并覆盖它们

覆盖通常不是问题，但如果目标文件夹中的文件有 Read Only 则会失败。属性。您可以在 MSDN Article 中了解更多信息

发生的情况是当您第一次从 CD 驱动器复制文件时，复制的文件保留了只读属性。您可以通过右键单击文件并检查其属性来检查。

要解决此问题，您需要重置文件属性或删除该文件夹中的文件。

要删除，您可以简单地使用

On Error Resume Next
Kill "C:\MyFolder\*.*"
On Error GoTo 0

要更改属性，您必须遍历文件并检查其属性是否为只读。你可以这样做

If fso.GetFile(Dest_File).Attributes And 1 Then 

并重置它，你必须使用

fso.GetFile(Dest_File).Attributes = fso.GetFile(Dest_File).Attributes - 1

一旦你这样做，你将能够复制文件。