[Resolvido]Erro ao mover pasta

Bom dia aos amigos do fórum.
Gostaria que pudessem me ajudar com o um pequeno problema, tenho um código no qual editei para mover pastas do meu Desktop para uma pasta da Rede, o código realiza a função, exibe a msgBox, porém não funciona.
Poderiam me ajudar? Desde já agradeço!
Código disponibilizado por JPaulo
Segue:

Código:


Private Sub Mover_Pasta_Click()
Dim fso
Dim sfol As String, dfol As String
sfol = "c:\Users\gabriel.p.lisboa\Desktop\Teste Transporte\" ' caminho de origem da pasta
dfol = "f:\Gabriel_Lisboa\Teste\" ' caminho de destino da pasta
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(dfol) Then
fso.CopyFolder sfol, dfol
Else
MsgBox dfol & " - Copiada com sucesso!", vbExclamation, "Sucesso"
End If
End Sub


Olá Gabriel Nascimento,

Estive a testar e cheguei à conclusão que funciona para uma pasta destino da raiz.
Exemplo: c:\PastaDestino

Como pretende para uma SubPasta, mo seu caso deve ter a pasta criada:
f:\Gabriel_Lisboa\
e a subpasta Teste será criada

Caso a pasta destino fosse:
f:\Gabriel_Lisboa\Teste\Hoje
Deverá ter criado as pastas até a anterior da ultima subPasta
f:\Gabriel_Lisboa\Teste

Devo confessar que fiquei sem compreender como mover de SubPastas para SubPastas.
Pode ser que o nosso amigo JPaulo possa esclarecer.
Abraço

Teste e retorne;

Código:

Public Sub CopiaPasta()
Dim FSO As Object
Dim sfol As String, dfol As String
sfol = "c:\Users\gabriel.p.lisboa\Desktop\Teste Transporte" ' caminho de origem da pasta
dfol = "f:\Gabriel_Lisboa\Teste" ' caminho de destino da pasta

    If Right(sfol, 1) = "\" Then
        sfol = Left(sfol, Len(sfol) - 1)
    End If

    If Right(dfol, 1) = "\" Then
        dfol = Left(dfol, Len(dfol) - 1)
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(sfol) = False Then
        MsgBox sfol & " não existe..."
        Exit Sub
    End If

    FSO.CopyFolder Source:=sfol, Destination:=dfol
    MsgBox dfol & " - Copiada com sucesso! ", vbExclamation, "Sucesso"
End Sub

Amigo JPaulo,
Aqui no 2007, dá erro 76 (path not found).
Mantem o mesmo criterio da minha ultima mensagem.
Abraço

(path not found) não pode dizer, ou não está a usar o ultimo código passado.

Esta pasta de exemplo, tem de existir sempre

Código:

"c:\Users\gabriel.p.lisboa\Desktop\Teste Transporte"

Esta pasta de destino com o nome de "Teste" se não existir ele cria e leva leva o conteudo da pasta de origem "Teste Transporte",

Código:

f:\Gabriel_Lisboa\Teste

O código leva todas as pastas que existirem dentro da pasta "Teste Transporte"

Amigo, não compreendo


Se criar a pasta sav2 funfa!

Mais uma nota:
No meu teste não tenho sequer a pasta sav2 criada.

Se criar a pasta de raiz (sav2) aí funfa.

Intão ???

O destino tem de ter sempre a primeira pasta mencionada em "dfol".

Se a segunda não existir, ele cria e cola todas as pasta de origem lá.

Como é que você quer que funcione da forma que está a mencionar ?

Mestres bom dia, Funcionou perfeitamente. Mais uma vez agradeço pela grande ajuda!

Colega Teixeira, este é para você testar;

Delete as pastas "Sav2" e "Teste" do seu diretorio C:\

Código:

Public Sub CopiaPasta()
Dim fso As Object
Dim sfol As String, dfol As String
Dim SeparaDiretorio() As String


sfol = "C:\Sav" ' caminho de origem da pasta
dfol = "C:\Sav2\Teste" ' caminho de destino

SeparaDiretorio = Split(dfol, "\")

i = 0

    Set fso = CreateObject("scripting.filesystemobject")
   
'Se a pasta "Sav2" e a subpasta "Teste" não existir, cria de novo
For i = LBound(SeparaDiretorio()) To UBound(SeparaDiretorio())
        If i = 0 Then
            CreateDir = SeparaDiretorio(i)
        Else
            CreateDir = CreateDir & "\" & SeparaDiretorio(i)
        End If
        If Right(CreateDir, 1) = ":" Or IsNull(SeparaDiretorio(i)) Or (Left(CreateDir, 2) = "\\" And i = 2) Then
       
        Else
            If fso.FolderExists(CreateDir) = False Then
                fso.CreateFolder (CreateDir)
            End If
        End If
Next i


    If Right(sfol, 1) = "\" Then
        sfol = Left(sfol, Len(sfol) - 1)
    End If

    If Right(dfol, 1) = "\" Then
        dfol = Left(dfol, Len(dfol) - 1)
    End If


    If fso.FolderExists(sfol) = False Then
        MsgBox sfol & " não existe..."
        Exit Sub
    End If

    fso.CopyFolder Source:=sfol, Destination:=dfol
    MsgBox dfol & " - Copiada com sucesso! ", vbExclamation, "Sucesso"
End Sub

Olá a todos,
Gabriel, obrigado pelo retorno, os utilizadores do fórum agradecem.

JPaulo, então se tiver ficheiros na pasta SAV e no nosso sistema não existir a pasta SAV2, não podemos copiar e criar automaticamente a pasta destino com este código.

Eu quando tenho essa necessidade, opto por usar o xcopy na shell com os parammetros /i/y
Usando também a função do artigo abaixo para controlar quando finalizou:

Código:

https://msdn.microsoft.com/en-us/library/bb258148(v=office.12).aspx

Fica mais esta para este grande Fórum MaximoAccess

"no nosso sistema não existir a pasta SAV2, não podemos copiar e criar automaticamente a pasta destino"

Veja e teste o ultimo código, feito especialmente para si.

Amigo JPaulo, funfou na perfeição!  
Fica mais um excelente tópico
Abraço a todos