Depois posto novamente.
Cumprimentos.
Sub CopiaDrop()
On Error GoTo TrataErro
Dim origem As String, destino As String
Dim OrigemFotos As String
'-----------------------------------------------------------
'Carrega a variável com o caminho da pasta Public no DropBox
'-----------------------------------------------------------
destino = "C:\Users\" & Environ("UserName") & "\Dropbox\Public\"
'-------------------------------------------------------------------------------------
'Carrega na variável o caminho da pasta public no dropBox acrescido do nome do arquivo
'-------------------------------------------------------------------------------------
destinoFotos = "C:\Users\" & Environ("UserName") & "\Dropbox\Public\Fotos.rar"
'---------------------------------------
'Carrega na variável o caminho do backup
'---------------------------------------
origem = CurrentProject.path & "\Backup\"
'---------------------------------------------------------------------------------------------------------------
'Se a chkBox selfotos está marcada carrega a variável para o caminho da pasta fotos acrescido no nome do arquivo
'---------------------------------------------------------------------------------------------------------------
If Me.SelFotos = -1 Then: OrigemFotos = CurrentProject.path & "\Fotos\Fotos.rar"
'----------------------------------------------------------------------
'Se está marcado a ChkBox SelWinRar verifica o último arquivo de backup
'----------------------------------------------------------------------
If Me.selWinrar = -1 Then
origem = origem & VerificaDataArqRar
destino = destino & VerificaDataArqRar
FileCopy origem, destino
Else
origem = origem & VerificaDataArq
destino = destino & VerificaDataArq
FileCopy origem, destino
TentaNovamente:
'---------------------------------------------------------------------------------------
'Se a ChkBoz selFotos está marcada copia o arquivo zipado da pasta fotos depois o exclui
'---------------------------------------------------------------------------------------
If Me.SelFotos = -1 Then: FileCopy OrigemFotos, destinoFotos: Kill OrigemFotos
End If
Exit Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Tratamento de Erros
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Exit_TrataErro:
DoCmd.Hourglass False
DoCmd.Echo True
Exit Sub
TrataErro:
Select Case err.Number
Case 70
'-----------------------------------------------------------------------------------------
'Erro gerado caso tente copias o arquivo Fotos.rar enquanto ainda estiver sendo compactado
'Provoca uma pause de 5 segundos e remete novamente à cópia
'-----------------------------------------------------------------------------------------
Pause (5)
MsgBox "Erro ao copiar as fotos, o programa" _
& vbNewLine & "executará a ação novamente," _
& vbNewLine & "Após o termino da compactação na Barra" _
& vbNewLine & " de tarefas clique em OK para continuar", vbCritical, "AGUARDE"
GoTo TentaNovamente
Case Else
DoCmd.Hourglass False
DoCmd.Echo True
MsgBox "Erro Gerado no form frmBakup" _
& vbNewLine & "No Procedimento CopiaDrop" _
& vbNewLine & "Erro Número: " & err.Number _
& vbNewLine & "linha: " & Erl _
& vbNewLine & "Descrição: " & err.Description _
& vbNewLine & "Por favor contate o Administrador de Sistema.", vbCritical, err.Number & ", linha:" & Erl
End Select
End Sub