Copyfile permission denied

Hello,

I created a VBA code that allows me to copy JPG files to an external hard drive.
It only copies the files based on the creation date that I selected.
I also have a VBA code that detects the letter, for example F:\, of the external hard drive because sometimes this letter changes.

However, every time I run my VBA code, there is often an error (70) permission denied that prevents me from copying the files.
Maybe it's because the destination folder on the external hard drive is read-only?
I have already manually disabled the read-only attribute of this folder, but it reactivates itself:

I am giving you my complete VBA code because you never know if this Error (70) is due to a missing or poorly written piece of code.

Thank you in advance for your help

Sheets("cp87").Select
Sheets("macros").Range("a203").Value = ""
Dim appShell As Object
Dim FileName As Variant
Dim FilePath As Variant
Dim oFolder As Object
Dim oFolderItem As Object
Dim testdate As Variant

FolderPath = "D:\Users\Public\IMPORT\TAGSIMPORTAFAIRE\"
FileName = "*.jpg"

EnterDate:
testdate = InputBox("enter the date of renaming the tags." & vbCrLf & "Example: 27/11/2014", "enter the date", (Date))
If testdate = "" Then Exit Sub
If Not IsDate(testdate) Then
MsgBox "The entered date is not valid." & vbCrLf _
& "Please re-enter the date."
GoTo EnterDate
End If
testdate = CDate(testdate)

Set appShell = CreateObject("Shell.Application")
Set oFolder = appShell.Namespace(FolderPath)

For Each oFolderItem In oFolder.Items
If oFolderItem.Name Like FileName Then

If DateValue(oFolder.GetDetailsOf(oFolderItem, 3)) = testdate Then

If Not oFolderItem.Name Like "*TAGSAFAIRE*" Then
a = a + 1
Dim destination As String
Dim objDrive As Object
With CreateObject("Scripting.FileSystemObject")
For Each objDrive In .Drives
If objDrive.IsReady Then
If objDrive.VolumeName = "VERBATIM HD" Then
destination = objDrive.Path & "\SAUVEGARDE IMPORT\"
Sheets("macros").Range("a203").Value = "YES"
Exit For
End If
End If
Next
End With
If Sheets("macros").Range("a203").Value = "" Then
MsgBox "The external backup drive is not connected via USB!", vbCritical
Exit Sub
End If

Dim xlobj As Object
Set xlobj = CreateObject("Scripting.FileSystemObject")
xlobj.CopyFile FolderPath & oFolderItem.Name, destination & oFolderItem.Name, True

Set xlobj = Nothing

End If

End If
End If

Next oFolderItem

If a = "" Then
MsgBox "There are no tags for the selected date: " & testdate & vbCrLf _
& "Please choose another date", vbCritical
Exit Sub
Else
MsgBox "There were: " & a & " tags renamed on: " & testdate & vbCrLf & _
"without duplicates and without tags that were not renamed."
End If

Dim appShell2 As Object, oFolder2 As Object, oFolderItem2 As Object

FolderPath = "D:\Users\Public\IMPORT\TAGSIMPORTAFAIRE\"
Set appShell2 = CreateObject("Shell.Application")
Set oFolder2 = appShell2.Namespace(FolderPath)

Dim rng As Range, cellul As Range
Set rng = Sheets("archivage").Range("z2:z65000")
For Each cellul In rng
If cellul.Value <> "" Then
On Error GoTo suit
b = b + 1
Dim xlobj2 As Object
Set xlobj2 = CreateObject("Scripting.FileSystemObject")
SetAttr FolderPath & cellul.Value, vbNormal
xlobj2.CopyFile FolderPath & cellul.Value, destination & cellul.Value, True

Set xlobj2 = Nothing
End If
suit::

Next cellul

If b = "" Then
Else
MsgBox "There were: " & b & " tags that were corrected: " & vbCrLf & _
"and which were saved on the external drive."
End If

Sheets("archivage").Range("z2:z65000") = ""
Exit Sub