Ошибка при копировании файлов в существующую папку

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-диска, файл, в котором было скопировано, сохранил свойство Read Only. Вы можете проверить это, нажав правой кнопкой мыши на файл и проверив их свойства.

Чтобы устранить эту проблему, вам необходимо сбросить атрибуты файла или удалить файлы в этой папке.

Для удаления, вы можете просто использовать

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

Как упоминал Сиддхарт, ошибка возникает из-за того, что код пытается перезаписать существующие файлы. Итак, если вы не хотите перезаписывать файлы, вы можете просто добавить сообщение 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