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

一旦你这样做，你就可以复制文件。

Answer 2

正如Siddharth所说，出现错误是因为代码试图覆盖现有文件。因此，如果您不想覆盖文件，只需添加If Error Resume Next。我正在使用的解决方案代码如下：

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")

On Error Resume Next

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

On Error GoTo 0

End Sub

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

2 个答案: