Notifications
Clear all

Macro - Backup da planilha em REDE

3 Posts
1 Usuários
0 Reactions
2,472 Visualizações
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Bom dia!

Office 2010 64 bits + Windows 7 64 bits

Criei uma rotina básica para fazer backup's da minha planilha num local em que eu determinar.

Sub CriarBackup()

    ARQUIVO = Range("H2").Value
    ARQUIVO = Range("H1") + ARQUIVO

    On Error GoTo Erro

    If (Dir(ARQUIVO) <> "") Then
    Kill ARQUIVO
    End If

    MkDir (Range("H1"))
    ThisWorkbook.SaveCopyAs Filename:=ARQUIVO

Fim:
    Exit Sub
Erro:
        MsgBox "Erro ao criar backup:" & vbCrLf & Err.Description, vbOKOnly + vbCritical, "Atenção"
        Err.Clear
    Resume Fim

End Sub

Ela está funcionando perfeitamente, menos quando tento fazer o backup em REDE, que é o que preciso agora.

Ná célula H1, é onde eu determino o caminho. Se eu colocar "C:" ou "D:" e mais qualquer coisa, ele faz, mas se coloco um endereço da REDE, exemplo: "\homeoperacoesExternaESTOQUE", ele não reconhece esse caminho.

Como resolvo isso?

 
Postado : 15/09/2011 6:01 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Caros, descobri que quando há arquivos dentro da pasta ele falha, e se eu tirar o

MkDir (Range("H1"))

Ele funciona. Como posso colocar para ele verificar se a pasta existe e caso a pasta não exista, criá-la?

 
Postado : 15/09/2011 7:09 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Para "salvar" seu Backup na rede:
1:= "Mapeie" o caminho como um drive de seu equipamento, e direcione o Arquivo para lá
(Deverá ficar algo como J:homeoperacoesExternaESTOQUE)
ou será preciso criar a coneção dinamicamente.

Para verificar se o diretorio já existe:

    Sub CriarBackup()

        Arquivo = Range("H2").Value
        Arquivo = Range("H1") + Arquivo
        
        On Error GoTo Erro
        
        'Verifica se o diretorio existe, se não existir, cria
        If (Dir(Range("H1"), vbDirectory) = "") Then
            MkDir (Range("H1"))
        End If
        'Verifica se o arquivo já existe, se existir, deleta
        If (Dir(Arquivo) <> "") Then
        Kill Arquivo
        End If
        'Salva copia do arquivo no caminho especificado
        ThisWorkbook.SaveCopyAs Filename:=Arquivo

Fim:
        Exit Sub
Erro:
            MsgBox "Erro ao criar backup:" & vbCrLf & Err.Description, vbOKOnly + vbCritical, "Atenção"
            Err.Clear
        Resume Fim

    End Sub
 
Postado : 15/09/2011 9:00 am