Por solicitação de colega do fórum, para que possa ajudar todos os que necessitarem, criei função para copiar ficheiro mantendo a data de criação. Será útil quando se utiliza a data de criação para manipular ficheiros.
Function CopiaFicheiro(EnderecoOrigem As String, EnderecoDestino As String) As Boolean
'Pode utilizar mantendo as duas linhas do cabeçalho
'criada por Alexandre Neves do fórum MaximoAccess
On Error GoTo MostraErro
Dim fso As FileSystemObject, fl As File, DataActual As Date
DataActual = Date
Set fso = New FileSystemObject
Set fl = fso.GetFile(EnderecoOrigem)
Date = fl.DateCreated
fso.CopyFile EnderecoOrigem, EnderecoDestino
Set fso = Nothing
CopiaFicheiro = True
Sair:
Date = DataActual
Exit Function
MostraErro:
If err.Number = 53 Then
MsgBox "O ficheiro " & EnderecoOrigem & " não existe."
Else
MsgBox err.Number & vbCr & err.Description, , "Ficheiro não copiado"
End If
GoTo Sair
End Function
Function CopiaFicheiro(EnderecoOrigem As String, EnderecoDestino As String) As Boolean
'Pode utilizar mantendo as duas linhas do cabeçalho
'criada por Alexandre Neves do fórum MaximoAccess
On Error GoTo MostraErro
Dim fso As FileSystemObject, fl As File, DataActual As Date
DataActual = Date
Set fso = New FileSystemObject
Set fl = fso.GetFile(EnderecoOrigem)
Date = fl.DateCreated
fso.CopyFile EnderecoOrigem, EnderecoDestino
Set fso = Nothing
CopiaFicheiro = True
Sair:
Date = DataActual
Exit Function
MostraErro:
If err.Number = 53 Then
MsgBox "O ficheiro " & EnderecoOrigem & " não existe."
Else
MsgBox err.Number & vbCr & err.Description, , "Ficheiro não copiado"
End If
GoTo Sair
End Function