Notifications
Clear all

Fazer backup de arquivo, atraves de macro vba

3 Posts
2 Usuários
0 Reactions
1,029 Visualizações
(@brunomotta)
Posts: 26
Eminent Member
Topic starter
 

Bom dia galera esperta,

Meus amigos venho humildemente, solicitar a ajuda de vcs. Sou novato com VBA em excel, venho aprendendo aos pouquinhos de forma autodidata.
Busquei outro dia um código na net, para fazer backup de um determinado arquivo.
Encontrei este que parece ser muito bom, mas tentei usá-lo em minha pasta de trabalho, mas não deu certo, como a forma em que foi dada para aplica-lo.

O código é este

Private Sub Workbook_Open()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error GoTo erros

'Retorna o caminho completo até o arquivo sendo utilizado + seu nome
este_arquivo = ActiveWorkbook.Path & "" & ActiveWorkbook.Name
'Divide o nome (provavelmente JonathanCP.xls) em JonathanCP e xls
nome_dividido = Split(ActiveWorkbook.Name, ".")
'Busca a ultima data de backup
ultimo_backup = Worksheets("backup_control").Cells(1, 2).Value
'Salva se ainda não existir nenhum backup ou caso não tenha sido salvo o backup do mês anterior
If ultimo_backup = "" Or Month(ultimo_backup) <> Month(DateSerial(Year(Date), Month(Date) - 1, Day(Date))) Then
'Novo nome do arquivo c:testeJonatanCP_abril_2009.xls por exemplo
novo_nome = "C:teste" & nome_dividido(0) & "_" & _
MonthName(Month(DateSerial(Year(Date), Month(Date) - 1, Day(Date)))) & "_" & _
Year(DateSerial(Year(Date), Month(Date) - 1, Day(Date))) & ".xls"
'Grava a data do ultimo backup
Worksheets("backup_control").Cells(1, 2).Value = DateSerial(Year(Date), Month(Date) - 1, Day(Date))
'Salva o Backup
ActiveWorkbook.SaveAs Filename:=novo_nome, _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
'Volta para o arquivo que estava sendo usado
ActiveWorkbook.SaveAs Filename:=este_arquivo, _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End If
'Os Month sobre DateSerial é para garantir que não exista o mês 0 (Caso seja janeiro)

erros:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

O problema é que já tenho um outro código Private Sub Workbook_Open(), trabalhando na THISWORKSBOOK, e aí dá erro dizendo que já existe este nome. Porém a minha intenção não é criar um backup automático ainda, e sim criar um macro em um botão para fazer esse procedimento de backup.
Gostaria de saber se há alguma forma de usar este código para fazer isso. no caso transformando em uma SUB em um módulo separado. Assim, eu poderei utilizar um botão manualmente para fazer esse backup o momento que eu preferir.

Amigos espero que vcs possam me ajudar. Valeu um abraço grande de seu amigo Bruno.
meu e-mail: [email protected] ( me desculpem se estou ferindo alguma regra do fórum colocando meu e-mail, mas ainda nem tive o tempo de ler o termo.)

 
Postado : 22/10/2015 9:33 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Já tentou usar o comando call (ou algo desse tipo), para chamar as rotinas?

Private Sub Workbook_Open()

Call Macro1
Call BackUp

End Sub

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 22/10/2015 9:38 am
(@brunomotta)
Posts: 26
Eminent Member
Topic starter
 

Mensagem não lidapor alexandrevba » Qui Out 22, 2015 12:38 pm

Boa tarde!!

Já tentou usar o comando call (ou algo desse tipo), para chamar as rotinas?
Código: Selecionar todos
Private Sub Workbook_Open()

Call Macro1
Call BackUp

End Sub

Olá alexandrevba,

Amigo ainda não testei e nem sei como seria aplicado kkk.

Você pode me explicar.

 
Postado : 22/10/2015 10:34 am