Hej!

Jag använde mig av ett kodexempel som är utformat av Staffan Berg tips326.

Jag har även pratat med Staffan och jag lyfter ut frågan hit.


Probklemet är att när vi skall kopiera filer till en mapp där det redan finns filer så får vi ett felmeddelande
Path/Access error

Här är koden
<code>
Public Sub dirCopy(FromPath As String, ToPath As String)
ReDim FileName(1) As String
Dim i As Long
Dim lR As String
Dim LastCopy As String
Dim LoppCount As Integer
ReDim FileName(1) As String


frmBackup.ProgressBar2.Visible = True
LoppCount = 0


' On Error GoTo Errhandler

'## Initsierar den övergipande process indikatorn
frmBackup.ProgressBar2.Min = 0
frmBackup.ProgressBar2.Max = frmBackup.ListView1.ListItems.Count

LoppCount = LoppCount + 1



'## Sätter värdet för huvudprocessen
frmBackup.ProgressBar2.Value = LoppCount

frmBackup.Label2.Caption = "Kopierar : " & FromPath

'## Sökvägen till frånmappen
frmBackup.File1.Path = FromPath

'## Antalet filer i katalogen
m_CountFiles = frmBackup.File1.ListCount

If m_CountFiles = 0 Then
m_CountFiles = 1
End If
frmBackup.ProgressBar1.Visible = True
frmBackup.ProgressBar1.Min = 0
frmBackup.ProgressBar1.Max = m_CountFiles

'## Loopar igenom Mappen och kopierar

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


If (Dir(FromPath, vbDirectory) <> "") And (Dir(ToPath, vbDirectory) <> "") Then

i = 0
FileName(i) = Dir(FromPath, vbDirectory)
While FileName(i) <> ""
If (GetAttr(FromPath & FileName(i)) And vbDirectory) = vbDirectory Then
If FileName(i) <> "." And FileName(i) <> ".." Then
i = i + 1
ReDim Preserve FileName(i + 1) As String
End If
Else
If flagBackupStopped = False Then
frmBackup.ProgressBar1.Value = i
FileCopy FromPath & FileName(i), ToPath & FileName(i)
frmBackup.Label1.Caption = "Kopierar : " & FromPath & "\" & FileName(i)
Else
frmBackup.List1.AddItem "Backup avslutad av användaren : " & Now
frmBackup.List1.AddItem "*************** AVBRUTEN ***************"
Exit Sub
End If

End If

FileName(i) = Dir
Wend

'Kopiera underkatalogerna
If i > 0 Then
For Each directory In FileName
If directory <> "" Then
'förbered den nya katalogen
MkDir ToPath & directory
nrOfCatalogs = nrOfCatalogs + 1
'kopiera katalogen
dirCopy FromPath & directory, ToPath & directory
End If
Next
End If
End If


'## Felhanterarer
'Errhandler:

' If Err.Number <> 0 Then
' '## Skriver felmeddelande till loggfil
' frmBackup.ERR_REPORT
' Select Case Err.Number
' Case 52 ' Mottagar katalogen kunde inte hittas
' List1.AddItem "ERROR : Fel vid säkerhetskopiering " & Now
' List1.AddItem "ERROR : Kan inte hitta mottagar mapp."
' List1.AddItem "ERROR : Avbryter säkerhetskopieringen och fortsätter med nästa steg"
' Err.Clear
' 'GoTo frmBackup.c
' Exit Sub
' End Select
' End If
End Sub
</code>

I koden
<code>
MkDir ToPath & directory
</code>

SÅ kommer felmeddelandet. och det verkar som att mapparna jag tidigare kopierade blir skrivskyddade så hur löser man det?


/Tyronne

Du får kanske lägga till en raderingsfunktion precis före kopieringen för att slippa detta problem.

If len(dir(dittfilnamnochkaltalog))>0 then kill dittfilnamnochkaltalog
... kopiera igen..

Jag provade att ta bort mappen men fick samma felmeddelande igen, dvs att mappen är skrivskyddad. Hitta då ett exempel där man ändrade attributen på mappen

här är koden

<code>
Sub DimReadOnly(ByRef objDat)

If objDat.Attributes = 16 Then
MsgBox objDat.Attributes
objDat.Attributes = objDat.Attributes - 16
MsgBox objDat.Attributes
End If
End Sub
</code>

Värdet för mappen är 16 vilket innebär skrivskyddad. I mitt exempel så sätter jag om värdet till 0 som är Normal. Jag har även provat att direkt sätta
<code>
objDat.Attributes = 0
</code>
men värdet förblir 16

Sökvägen till mappen är rätt mm

är det någon som kan ge mig en hint på varför värdet inte ändras..


/Tyronne