[Resolvido]Imprimir com Formulário do Exemplo do Piloto

Para solução do Backup, adequação dos caminhos Origem e Destino;

Private Function fncDestinoBackupPen(Optional Destino As String = "local") As String
Dim strNomeBackEnd As String
Dim SourceFile, DestinationFile
Dim StrWinRar As String
Dim DirTemp As String

DirTemp = CurrentProject.Path & "BackUp"

strDestinoPen = Replace(Destino, "local", StrLtr & "backup_SysBase")
    StrWinRar = Me.lbxfolders & strDestinoPen

If Len(Dir(strDestinoPen, vbDirectory) & "") = 0 Then FileSystem.MkDir (strDestinoPen)
strNomeBackEnd = fncNomeBackEnd
strNomeBackEnd = Left(strNomeBackEnd, InStrRev(strNomeBackEnd, ".accdb") - 1)
strNomeBackEnd = strNomeBackEnd & Format(Date, "ddmmyy") & "-" & Format(Time, "hhmmss") & ".accdb"
fncDestinoBackupPen = strDestino & "" & strNomeBackEnd
strDestinoPen = strDestinoPen & fncDestinoBackupPen

    SourceFile = Replace(Me.txDestino, "-", "-c")    ' Definir o nome do arquivo de origem.
    DestinationFile = Replace(SourceFile, "" & DirTemp & "", "" & StrWinRar & "")   ' Definir o nome do arquivo de destino."
If Me.selWinrar = -1 Then
    SourceFile = Replace(SourceFile, ".accdb", ".rar")
    strDestinoPen = Replace(strDestinoPen, ".accdb", ".rar")
    DestinationFile = Replace(SourceFile, "" & DirTemp & "", "" & StrWinRar & "")
    FileCopy DestinationFile, strDestinoPen
        MsgBox "Backup no Dispositivo Removível ." & vbCrLf & _
            vbCrLf & "efetuado com sucesso!", vbInformation, "Aviso"
            Beep
Else
FileCopy DestinationFile, strDestinoPen    ' Copiar a origem no destino.

 MsgBox "Backup no Dispositivo Removível ." & vbCrLf & _
        vbCrLf & "efetuado com sucesso!", vbInformation, "Aviso"
        Beep
End If
End Function

Amanha estarei postando novo exemplo com Registro do Softwere feito no Reg do windows, com uso do activeLock
Ficou interessante.

Cumprimentos.

Nova versão disponível.. com o ActiveLock

e ja funcionando o Backuo

Assis resolveste o Backup e a impressão do reltório?

Cumprimentos.

Harry
No backup pedido para a pendrive criou esta pasta "backup_SysBase", na pendrive, mas dentro desta pasta não tem nada, Mas também criou este ficheiro "backup_SysBaseSysBase_be130113-165001", em E:\

Não devia cria-lo dentro da pasta "backup_SysBase" ?

Quanto ao relatórios nada.

Obrigado bom fim de semana

Falta uma barra em algum lugar no codigo.. verei isto.

Quanto ao relatorio? Resolveu?

Cumprimentos.

Boas Assis, esta a funcionar aqui:


Private Function fncDestinoBackupPen(Optional Destino As String = "local") As String
Dim strNomeBackEnd As String
Dim SourceFile, DestinationFile
Dim StrWinRar As String
Dim DirTemp As String

DirTemp = CurrentProject.Path & "BackUp"

strDestinoPen = Replace(Destino, "local", StrLtr & "backup_SysBase")
StrWinRar = Me.lbxfolders & strDestinoPen
strDestinoPen = Me.lbxfolders & strDestinoPen
If Len(Dir(strDestinoPen, vbDirectory) & "") = 0 Then
MkDir strDestinoPen
End If
strNomeBackEnd = fncNomeBackEnd
strNomeBackEnd = Left(strNomeBackEnd, InStrRev(strNomeBackEnd, ".accdb") - 1)
strNomeBackEnd = strNomeBackEnd & Format(Date, "ddmmyy") & "-" & Format(Time, "hhmmss") & ".accdb"
fncDestinoBackupPen = strDestino & "" & strNomeBackEnd
strDestinoPen = strDestinoPen & fncDestinoBackupPen

SourceFile = Replace(Me.txDestino, "-", "-c") ' Definir o nome do arquivo de origem.
DestinationFile = Replace(SourceFile, "" & DirTemp & "", "" & StrWinRar & "") ' Definir o nome do arquivo de destino."
If Me.selWinrar = -1 Then
SourceFile = Replace(SourceFile, ".accdb", ".rar")
strDestinoPen = Replace(strDestinoPen, ".accdb", ".rar")
DestinationFile = Replace(SourceFile, "" & DirTemp & "", "" & StrWinRar & "")
FileCopy DestinationFile, strDestinoPen
MsgBox "Backup no Dispositivo Removível ." & vbCrLf & _
vbCrLf & "efetuado com sucesso!", vbInformation, "Aviso"
Beep
Else
FileCopy DestinationFile, strDestinoPen ' Copiar a origem no destino.

MsgBox "Backup no Dispositivo Removível ." & vbCrLf & _
vbCrLf & "efetuado com sucesso!", vbInformation, "Aviso"
Beep
End If
End Function



Cumprimentos.