[Resolvido]módulo para copiar arquivos causa travamento do Access

Boa tarde colegas..

Neste módulo, ao ser executado, na linha em destaque o access trava e da uma menssagem de erro pedindo para notificar a Microsoft sobre o mesmo.

Alguem tem ideia do que possa ser?


Option Compare Database
Option Explicit

'Como copiar arquivos com a animação de documentos voando de uma pasta para outra? 'A animação faz parte
'da função SHFileOperation de Shell32.dll, a ser executada com certos flags definidos como constantes num módulo.
'A função da API precisa de uma estrutura de dado chamada SHFILEOPSTRUCT:
'Veja um exemplo no site The Access Web, artigo "Copy a database":
'http://www.mvps.org/access/api/api0026.htm
'Here 's an API based method to make a backup of the current database.
'Please note that this function does not work on Exclusively opened database.
'The backup is created with a "Copy of (?)" prefix to the database name in the same directory as the original database itself.

'********** Code Start *************
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed, except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
' Code Courtesy of Dev Ashish
'*********************************************************************
Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Const FO_MOVE As Long = &H1
Private Const FO_COPY As Long = &H2
Private Const FO_DELETE As Long = &H3
Private Const FO_RENAME As Long = &H4

Private Const FOF_MULTIDESTFILES As Long = &H1
Private Const FOF_CONFIRMMOUSE As Long = &H2
Private Const FOF_SILENT As Long = &H4
Private Const FOF_RENAMEONCOLLISION As Long = &H8
Private Const FOF_NOCONFIRMATION As Long = &H10
Private Const FOF_WANTMAPPINGHANDLE As Long = &H20
Private Const FOF_CREATEPROGRESSDLG As Long = &H0
Private Const FOF_ALLOWUNDO As Long = &H40
Private Const FOF_FILESONLY As Long = &H80
Private Const FOF_SIMPLEPROGRESS As Long = &H100
Private Const FOF_NOCONFIRMMKDIR As Long = &H200

Private Declare Function apiSHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Function fMakeBackup(wOrigem, wDestino) As Boolean

Dim StrMsg As String
Dim tshFileOp As SHFILEOPSTRUCT
Dim lngRet As Long
Dim strSaveFile As String
Dim lngFlags As Long
Const cERR_USER_CANCEL = vbObjectError + 1
Const cERR_DB_EXCLUSIVE = vbObjectError + 2
On Local Error GoTo fMakeBackup_Err

If fDBExclusive = True Then err.Raise cERR_DB_EXCLUSIVE

StrMsg = "Você tem certeza que quer fazer a cópia?"

If MsgBox(StrMsg, vbQuestion + vbYesNo, "Confirme !") = vbNo Then err.Raise cERR_USER_CANCEL

lngFlags = FOF_SIMPLEPROGRESS Or _
FOF_FILESONLY Or _
FOF_RENAMEONCOLLISION

strSaveFile = CurrentDb.Name

With tshFileOp
.wFunc = FO_COPY
.hWnd = hWndAccessApp
.pFrom = wOrigem & vbNullChar
.pTo = wDestino & vbNullChar
.fFlags = lngFlags
End With
lngRet = apiSHFileOperation(tshFileOp)
fMakeBackup = (lngRet = 0)
fMakeBackup_End:
Exit Function
fMakeBackup_Err:
fMakeBackup = False
Select Case err.Number
Case cERR_USER_CANCEL:
'do nothing
Case cERR_DB_EXCLUSIVE:
MsgBox "The current database " & vbCrLf & CurrentDb.Name & vbCrLf & _
vbCrLf & "is opened exclusively. Please reopen in shared mode" & _
" and try again.", vbCritical + vbOKOnly, "Database copy failed"
Case Else:
StrMsg = "Error Information..." & vbCrLf & vbCrLf
StrMsg = StrMsg & "Function: fMakeBackup" & vbCrLf
StrMsg = StrMsg & "Description: " & err.Description & vbCrLf
StrMsg = StrMsg & "Error #: " & Format$(err.Number) & vbCrLf
MsgBox StrMsg, vbInformation, "fMakeBackup"
End Select
Resume fMakeBackup_End
End Function


Cumprimentos.

Print do relatorio de erro

Boa tarde, Piloto
Este código é que publicou aqui http://maximoaccess.forumeiros.com/t2658-resolvidoerro-na-copia-do-arquivo ?
Tem funcionado sem erro e, agora, começou a dar erro? O que alterou?
Abraço,

Pois é AMigo Alexandre... Me lembrei disso... Inclusive esta funcionando no Syspen em outro PC... apenas copiei os objetos para um Novo BD no meu not.. e deu o erro... o mesmo que havia dado quando publiquei este post.


Pesquisei e achei este tópico e o apliquei. Resolveu

http://maximoaccess.forumeiros.com/t8785-resolvidocopiar-ou-mover-arquivos-entre-diretorios?highlight=copiar+arquivo


Grato.