Só uma obs quanto a Function do Fernando, para que a mesma funcione devemos habilitar em Referências a Biblioteca "Microsoft Scripting Runtime".
Bernardo, na Function criada, seria o caso só de alterar a linha que define o diretório : Pasta = "W:TESTE" para Pasta = "C:TESTE", lembrando que como a instrução está logo no inicio, se o Diretório ainda não existir dará erro.
Agora quanto a sua rotina, como está com o Titulo de "backup", imagino que seria para se criar um "Backup" ou Cópia da Pasta que estivermos trabalhando, se for isto a mesma contem alguns erros nas instruções :
Primeiro você já definiu o Diretorio na Variavel Pasta : Pasta = "C:cliente", depois colocou a instrução para verificar se o arquivo existe :
If Dir(Pasta & "backup.xlsm", vbArchive) = Empty Then - Estamos verificando se existe o arquivo de nome "backup.xlsm" na pasta "C:cliente", ok
Mas se ou não não existir, você usou a propriedade ChDir para alterar o caminho, ficando:
ChDir "C:cliente"
Mas na próxima instrução, esta definição não tem efeito, uma vez que o arquivo será salvo no caminho já definido na Variável "Pasta" e não no novo caminho "C:cliente"
wb.SaveAs Filename:=Pasta & "backup.xlsm"
Uma outra obs sobre a instrução acima, é a utilização do SaveAs, ela não Salva uma cópia e sim salva o arquivo que está utilizando com o novo nome definido em FileName, ou seja, "backup.xlsm", então se a intensão é fazer um backup do arquivo que estamos utilizando(guardar uma cópia), devemos utilizar "SaveCopyAs".
Nas outras linhas temos novamente as declarações utilizando ChDir sem necessidade, pelo menos da forma que estão, pois continuamos salvando o arquivo conforme o caminho definido na Variavel "Pasta".
Então quando utilizamos o ChDir para alterar o caminho ele já fica automaticamente alterado na memoria, sendo assim escreveríamos a instrução da seguinte forma para salvar o arquivo no novo caminho:
wb.SaveAs Filename:= "backup(" & i & ").xlsm" - sem a utilização da Variável Pasta
Não entendi o porque do For ... Next (2 to 200), se não estamos contando a quantidade de arquivos na pasta, pois desta forma a Variável "i" será sempre "2".
Nas linhas seguintes temos novamente o ChDir, lembrando que uma vez utilizado, enquanto não alterarmos novamente ela será sempre o Último Caminho Definido, então não precisamos alimenta-la novamente.
Então como o caminho já estava definido, não precisamos de declara-lo na instrução abaixo ;
If Dir("C:clientebackup(" & i & ").xlsm", vbArchive) = Empty Then
ficando sómente :
If Dir("backup(" & Cont & ").xlsm", vbArchive) = Empty Then
As linhas abaixo acredito que com a explicação acima já de para entender o porque não precisaria existirem.
Voltando a ideia de queremos fazer um "Backup" ou seja uma Cópia de Segurança do arquivo que estamos utilizando, eu sugiro a rotina abaixo :
Sub BackupMauro()
Dim PastaBkp As String
Dim wb As Workbook
Dim Cont As Long
Dim ArquivoExiste As Boolean
'Definimos o Caminho para Salvar a Cópia
PastaBkp = "C:Backup"
Set wb = ActiveWorkbook
'Verificamos se já existe uma cópia com o nome "Backup"
If Dir(PastaBkp & "backup.xls", vbArchive) = Empty Then
'Setamos o Caminho
ChDir PastaBkp
'Lembrando que a instrução abaixo, não salva uma cópia
'e sim salva o arquivo que estamos usando com o novo Nome
' wb.SaveAs Filename:=PastaBkp & "backup.xlsm"
'Salva uma copia (Backup) do arquivo no caminho especificado
wb.SaveCopyAs Filename:="backup.xls"
Else
'Variável se o arquivo existe
ArquivoExiste = True
'Verificamos quantos arquivos *.xls" temos na Pasta onde definimos acima
'Para as cópias
With Application.FileSearch
.LookIn = PastaBkp
.FileType = msoFileTypeExcelWorkbooks
.Execute
'Só para ilustração, pode apagar
MsgBox (.FoundFiles.Count)
'Aramzenamos a quantidade de arquivos
Cont = (.FoundFiles.Count)
End With
'E salvamos uma Cópia com o nome "backup + o numero armazenado
'na Variável Cont
wb.SaveCopyAs Filename:=PastaBkp & "backup(" & Cont & ").xls"
End If
End Sub
Na rotina acima a instrução Application.FileSearch, veja que só estamos verificando pelo tipo de arquivo (.FileType = msoFileTypeExcelWorkbooks) e não pelo nome, mas isto seria o caso de ajustar.
Não sei se fugi um pouco do assunto do tópico, mas fica ai mais uma idéia de se fazer os Backups.
[]s
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 22/05/2013 7:18 pm