Backup com combo selecionando o Drive C: D: ou E

http://www.esnips.com/doc/ad57f4c2-183b-4119-82fe-f029277c572d/BackupDrives

Concluido, créditos para 10%Topbr e 90%JPaulo.
Seleciona drive para fazer backup do bd e back end, tem opção de escolher a pasta e caso o drive não exista, o sistema avisa.

A função que verifica se o Drive existe é esta, é só adaptar;

Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias _
"GetLogicalDriveStringsA" (ByVal nespacoLength As Long, _
ByVal lpespaco As String) As Long


Public Function VerificaSeDriveExiste(ByVal LetraDoDrive As String) As Boolean
Dim espaco As String
espaco = Space(64)
If Len(LetraDoDrive) = 0 Then Exit Function
GetLogicalDriveStrings Len(espaco), espaco
VerificaSeDriveExiste = InStr(1, espaco, Left$(LetraDoDrive, 1), vbTextCompare)
If VerificaSeDriveExiste = True Then
MsgBox "Drive Existente..."
Else
MsgBox "Drive não Existente..."
End If
End Function

Ok, valeus, vou adaptar, depois posto a atualização.

Private Sub CBO_Drives_AfterUpdate()
Select Case CBO_Drives
Case Is = "C:"
Me.ImagemBackupC.Visible = True
Me.ImagemBackupD.Visible = False
Me.ImagemBackupE.Visible = False
If VerificaSeDriveExiste("C") = False Then
MsgBox "Drive não Existente..."
Cancel = True
Exit Sub
Else
Call CopiaDriveC
End If


Case Is = "D:"
Me.ImagemBackupD.Visible = True
Me.ImagemBackupC.Visible = False
Me.ImagemBackupE.Visible = False
If VerificaSeDriveExiste("D") = False Then
MsgBox "Drive não Existente..."
Cancel = True
Exit Sub
Else
Call CopiaDriveD
End If


Case Is = "E:"
Me.ImagemBackupD.Visible = False
Me.ImagemBackupC.Visible = False
Me.ImagemBackupE.Visible = True
If VerificaSeDriveExiste("E") = False Then
MsgBox "Drive não Existente..."
Cancel = True
Exit Sub
Else
Call CopiaDriveE
End If
End Select
End Sub

Retira as mensagens do código e coloque num modulo novo:

Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias _
"GetLogicalDriveStringsA" (ByVal nespacoLength As Long, _
ByVal lpespaco As String) As Long


Public Function VerificaSeDriveExiste(ByVal LetraDoDrive As String) As Boolean
Dim espaco As String
espaco = Space(64)
If Len(LetraDoDrive) = 0 Then Exit Function
GetLogicalDriveStrings Len(espaco), espaco
VerificaSeDriveExiste = InStr(1, espaco, Left$(LetraDoDrive, 1), vbTextCompare)
End Function

Perfeitooooo, vou fazer aqui, grande abraço JPaulo.

Enchendo mais um pouquinho vc, seguinte criei 3 textbox uma para digitar a Pasta para salvar uma com o drive c:\ essa fica em oculto e outra que concatena as duas formando o caminho.

A pasta até é criada, mas não esta fazendo a cópia, vc consegue ver o erro?
CaminhoEscolhido é a textbox que concatena.

On Error Resume Next
If MsgBox("Deseja fazer uma cópia do sistema no Drive C:? ", vbYesNo, "Aviso de Saída") = vbYes Then
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists([CaminhoEscolhido]) Then ' verifica se já existe a pasta
Else
MkDir [CaminhoEscolhido] ' se não existir cria
End If

Dim CopiaSegura As Object
Dim Caminho As String
Dim CopiaBancoTabelas As Object
Dim CaminhoTabelas As String

Caminho = [CaminhoEscolhido] 'Nome da pasta e nome de inicio para o banco de backup
Set CopiaSegura = CreateObject("Scripting.FileSystemObject")
CopiaSegura.CopyFile CurrentProject.path & "\ASCP Controle de Estoque - Modificado.accdb", Caminho & Format(Now, "_yyyy") & ".accdb"

Só testando, mas retire o On Error Resume Next para ver se existe algum erro, depois de tudo a funcionar já pode colocar de novo.

Tópico movido para esta sala, quando o exemplo estiver finalizado, coloque no Repositório de Exemplos.

Não deu erro, mas cria a pasta mas não faz a cópia.

No primeiro exemplo cria tudo sem problemas.

Cole aqui de novo o exemplo já com essas modificações, para eu ver.

Public Function CopiaDriveC()
'On Error Resume Next
If MsgBox("Deseja fazer uma cópia do sistema no Drive C:? ", vbYesNo, "Aviso de Saída") = vbYes Then
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists([CaminhoEscolhido]) Then ' verifica se já existe a pasta
Else
MkDir [CaminhoEscolhido] ' se não existir cria
End If

Dim CopiaSegura As Object
Dim Caminho As String
Dim CopiaBancoTabelas As Object
Dim CaminhoTabelas As String

Caminho = [CaminhoEscolhido] 'Nome da pasta
Set CopiaSegura = CreateObject("Scripting.FileSystemObject")
CopiaSegura.CopyFile CurrentProject.path & "\ASCP Controle de Estoque - Modificado.accdb", Caminho & Format(Now, "_yyyy") & ".accdb"

CaminhoTabelas = [CaminhoEscolhido] 'Nome da pasta
Set CopiaBancoTabelas = CreateObject("Scripting.FileSystemObject")
CopiaBancoTabelas.CopyFile CurrentProject.path & "\Sistema\ASCP Controle de Estoque - Modificado_be.accdb", CaminhoTabelas & Format(Now, "_yyyy") & ".accdb"
MsgBox "Cópia de segurança efetuada com sucesso"
End If
End Function

Fiz assim e funfou na perfeição.


Private Sub CBO_Drives_AfterUpdate()
Me.CaminhoEscolhido = Me.CBO_Drives & "\" & "Backup Sistema"
Select Case CBO_Drives
Case Is = "C:"
Me.ImagemBackupC.Visible = True
Me.ImagemBackupD.Visible = False
Me.ImagemBackupE.Visible = False
If VerificaSeDriveExiste("C") = False Then
MsgBox "Drive não Existente..."
Cancel = True
Exit Sub
Else
Call CopiaDriveC
End If


Case Is = "D:"
Me.ImagemBackupD.Visible = True
Me.ImagemBackupC.Visible = False
Me.ImagemBackupE.Visible = False
If VerificaSeDriveExiste("D") = False Then
MsgBox "Drive não Existente..."
Cancel = True
Exit Sub
Else
Call CopiaDriveD
End If


Case Is = "E:"
Me.ImagemBackupD.Visible = False
Me.ImagemBackupC.Visible = False
Me.ImagemBackupE.Visible = True
If VerificaSeDriveExiste("E") = False Then
MsgBox "Drive não Existente..."
Cancel = True
Exit Sub
Else
Call CopiaDriveE
End If
End Select
End Sub


Public Function CopiaDriveC()
'On Error Resume Next
If MsgBox("Deseja fazer uma cópia do sistema no Drive C:? ", vbYesNo, "Aviso de Saída") = vbYes Then
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(Me.CaminhoEscolhido) Then ' verifica se já existe a pasta
Else
MkDir Me.CaminhoEscolhido ' se não existir cria
End If

Dim CopiaSegura As Object
Dim Caminho As String
Dim CopiaBancoTabelas As Object
Dim CaminhoTabelas As String

Caminho = Me.CaminhoEscolhido 'Nome da pasta e nome de inicio para o banco de backup
Set CopiaSegura = CreateObject("Scripting.FileSystemObject")
CopiaSegura.CopyFile CurrentProject.path & "\BackupDrives.mdb", Caminho & Format(Now, "_yyyy") & ".mdb"

CaminhoTabelas = "C:\Backup Sistema\BackupTabelas" 'Nome da pasta e nome de inicio para o banco de backup
Set CopiaBancoTabelas = CreateObject("Scripting.FileSystemObject")
CopiaBancoTabelas.CopyFile CurrentProject.path & "\BackupDrives_be.mdb", CaminhoTabelas & Format(Now, "_yyyy") & ".mdb"
MsgBox "Cópia de segurança efetuada com sucesso"
End If
End Function

então, só que nesse trecho seu
Me.CaminhoEscolhido = Me.CBO_Drives & "\" & "Backup Sistema"

o Backup Sistema tem como ser uma cbotbox? pois quero que a pessoa selecione o valor padrão Backup Sistema, ou digite uma pasta, entende?

Consegui!!! a noite posto o arquivo nos repositórios, nossa, que trampo, rs fiz diferende de vc.
na fonte de controle do CaminhoEscolhido coloquei:
=[CBO_Drives] & "\" & [cxPasta] & "\"

CBO_Drives, combo que seleciona o drive
cxPasta, é a combo para seleciorar a pasta ou digitar uma nova para backup

Muito bem top, às vezes a oportunidade está fora do campo visual, então precisamos ficar atentos em tudo que temos em um ângulo de 360 graus para não perder nenhuma chance, rsrsrs. Alguem falou algo parecido com isso não sei quando e nem aonde, rsrsrsr.

Ja ouvi uma frase tb, existem 1000 maneiras de fazer Nestum"" rs

Se eu tiver 50% dos conhecimentos do paulo, ficarei rico, rs

esta pronto JPaulo.

Bom dia.

O link não está funcionando.