Faça uma pergunta »

VBA - Excel Mover qualquer tipo de arquivo

Julho 2015


Pequeno aplicativo para mover seus arquivos (de qualquer tipo) de um diretório "fonte" para um diretório de "destino".


Introdução


Software necessário para este aplicativo: Excel (todas as versões superiores a 97)

Referências - Editor VBE : "Microsoft Scripting Runtime"

Este procedimento utiliza uma biblioteca de objetos que, por padrão, não está incluída no editor do VBE. Devemos, então, adicionar uma referência a esta biblioteca:
  • No VBE : (para acessá-lo, a partir de uma planilha da sua pasta do Excel, pressione simultaneamente as teclas ALT+F11)
    • Menu : Ferramentas
    • Escolher: Referências
    • Marcar: "Microsoft Scripting Runtime"


Dois UserForms são necessários, aproveite o fato de ainda estar no VBE para criá-los:

Criação dos UserForms:
  • No VBE:
    • Menu : Inserção
    • Escolher: UserForm


Controles a serem inseridos:

No l'UserForm1 :

- 4 Botões de Comando, (CommandButton1, CommandButton2, CommandButton3, CommandButton4)
- 2 Labels, encarregado de acolher os caminhos d acesso (Label1, Label2)
- 5 Labels, encarregado de acolher os nomes dos cabeçalhos das colunas da Listbox (Label3, Label4, Label5, Label6, Label7)
- 2 CheckBox (CheckBox1 (selecionar todos os arquivos), CheckBox2(Novo diretório))
- 1 ListBox (ListBox1)

No UserForm2 :
- 2 Botões de Comando, (CommandButton1, CommandButton2)
- 1 TextBox (TextBox1)
- 1 Label (facultativo)

UserForm1


Código do UserForm1
Opção Explicit   

'---------------------------------------   
'Procedimento de seleção de todos os arquivos da listbox   
Private Sub CheckBox1_Click()   
Dim i As Long   

If CheckBox1.Value = True Then   
    For i = 0 To ListBox1.ListCount - 1   
        If ListBox1.Selected(i) = False Then ListBox1.Selected(i) = True   
    Next i   
Else   
    For i = 0 To ListBox1.ListCount - 1   
        If ListBox1.Selected(i) = True Then ListBox1.Selected(i) = False   
    Next i   
End If   
End Sub   

'-------------------------------------   
'Mostre o UserForm2 para criar um novo diretório  
Private Sub CheckBox2_Click()   

If CheckBox2.Value = True Then   
    UserForm2.Show   
End If   
End Sub   

'--------------------------------------   
'Escolha do diretório de destino   
Private Sub CommandButton2_Click()   
Dim objShell As Object, objFolder As Object   

    Set objShell = CreateObject("Shell.Application")   
    Set objFolder = objShell.BrowseForFolder(&H0&, "Escolher um diretório", &H1&)   

If objFolder Is Nothing Then   
    MsgBox "Abandono do operador", vbCritical, "Cancelamento"   
Else   
    Label2.Caption = objFolder.ParentFolder.ParseName(objFolder.Title).Path   
End If   
End Sub   

'---------------------------------------   
'Deslocamento dos arquivos selecionados   
Private Sub CommandButton3_Click()   
Dim i As Long   
Dim source As String, destin As String, message As String   
Dim oFSO As Scripting.FileSystemObject   
Dim Rep As Integer   

mensagem = "Tem certeza que quer mover os arquivos selecionados: " & vbLf & vbLf & Label1.Caption & vbLf & vbLf & "para: " & vbLf & vbLf & Label2.Caption   
Rep = MsgBox(mensagem, vbYesNo + vbPergunta, "Confirmação")   
If Rep = vbYes Then   

    Set oFSO = New Scripting.FileSystemObject   
       
        For i = 0 To ListBox1.ListCount - 1   
            If ListBox1.Selected(i) = True Then   
                source = Label1.Caption & "\" & ListBox1.List(i)   
                destin = Label2.Caption & "\" & ListBox1.List(i)   
                If oFSO.FileExists(source) Then   
                    oFSO.MoveFile source, destin   
                End If   
            End If   
        Next i   
    ElementosDiretório Label1.Caption   
    MsgBox "Deslocamentos efetuados.", vbOKOnly + vbInformação, "Fim do processamento"   
Else   
    MsgBox "Abandono do operador", vbCritical, "Cancelamento"   
End If   
End Sub   

'--------------------------------------------   
'Eliminação dos controles do UserForm1   
Private Sub CommandButton4_Click()   
ListBox1.Clear   
Label1.Caption = ""   
Label2.Caption = ""   
CheckBox1.Value = False   
CheckBox2.Value = False   
End Sub   

'------------------------------------------   
'Inicialização da listbox   
Private Sub UserForm_Initialize()   
With ListBox1   
    .ColumnCount = 5   
    .ColumnWidths = "170;50;60;50;200"   
    .SetFocus  'inútil, apenas estético  
End With   
End Sub   

'----------------------------------------   
'escolha do diretório fonte   
Private Sub CommandButton1_Click()   
Dim objShell As Object, objFolder As Object   
       
    Set objShell = CreateObject("Shell.Application")   
    Set objFolder = objShell.BrowseForFolder(&H0&, "Escolher um diretório", &H1&)   

If objFolder Is Nothing Then   
    MsgBox "Abandono do operador", vbCritical, "Cancelamento"   
    End   
Else   
    ElementosDoDiretório objFolder.ParentFolder.ParseName(objFolder.Title).Path   
End If   
End Sub   

'-----------------------------------------   
'Preenchimento da listbox   
Private Sub ElementosDoDiretório(Caminho As String)   
Dim objShell As Object, strFileName As Object   
Dim objFolder As Object   
Dim NomFic As String, Passe As String   

    Set objShell = CreateObject("Shell.Application")   
    Set objFolder = objShell.Namespace(CStr(Chemin))   
       
Label1 = Caminho   
ListBox1.Clear   
For Each strFileName In objFolder.Items   
    If strFileName.isFolder = False Then   
        Passe = Caminho & "\" & strFileName & "*.*"   
        NomFic = Dir(Passe)   
        With ListBox1   
            .AddItem NomFic   
            .List(ListBox1.ListCount - 1, 1) = objFolder.GetDetailsOf(strFileName, 1)   
            .List(ListBox1.ListCount - 1, 2) = Format(objFolder.GetDetailsOf(strFileName, 4), "DD/MM/YYYY")   
            .List(ListBox1.ListCount - 1, 3) = Format(objFolder.GetDetailsOf(strFileName, 3), "DD/MM/YYYY")   
            .List(ListBox1.ListCount - 1, 4) = objFolder.GetDetailsOf(strFileName, 14)   
        End With   
    End If   
Next strFileName   
End Sub

UserForm2


Código do UserForm2

Opção Explicit   

Dim CaminhoDiretórioParente As String   

'-------------------------------------------   
'Escolha do diretório parente, no qual será criado o nosso diretório   
Private Sub CommandButton1_Click()   
Dim objShell As Object, objFolder As Object   
       
    Set objShell = CreateObject("Shell.Application")   
    Set objFolder = objShell.BrowseForFolder(&H0&, "Escolher um diretório", &H1&)   

If objFolder Is Nothing Then   
    MsgBox "Abandono do operador", vbCritical, "Cancelamento"   
Else   
    CaminhoDiretórioParente = objFolder.ParentFolder.ParseName(objFolder.Title).Path   
End If   
End Sub   

'--------------------------------------------   
'Criação do diretório   
Private Sub CommandButton2_Click()   
Dim oFSO As Scripting.FileSystemObject   
Dim oFld As Folder   
Dim CaminhoCompleto As String   

If TextBox1 = "" Then Exit Sub   
Set oFSO = New Scripting.FileSystemObject   

CaminhoCompleto = CaminhoDiretórioParente & "\" & TextBox1   
If oFSO.FolderExists(CaminhoCompleto) Then   
    MsgBox "Esta pasta já existe"   
    Exit Sub   
Else   
    On Error Resume Next   
    Set oFld = oFSO.CreateFolder(CaminhoCompleto)   
End If   
UserForm1.Label2.Caption = CaminhoCompleto   
UserForm1.CheckBox2.Value = False   
Unload Me   
End Sub   

'----------------------------------------------------   
'Impedir a entrada de caracteres proibidos ou não recomendados   
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)   
If InStr("""!{['^]}/\*?<>|:", Chr(KeyAscii)) <> 0 Then   
    MsgBox "Caractere proibido ou não recomendado"   
    KeyAscii = 0   
End If   
End Sub   

'-----------------------------------------------   
'vidage du Textbox1   
Private Sub UserForm_Initialize()   
TextBox1 = ""   
End Sub

Exemplo do uso


Em uma planilha do Excel, desenhe um botão de comando (no menu Exibir, barra de ferramentas: Caixa de ferramentas Controles).
No módulo da folha (para acessá-lo: Botão direito do mouse da planilha em questão/Visualizar o Código) copiar-colar este código:
Private Sub CommandButton1_Click()     
    'Inicializar     
    UserForm1.Show     
End Sub

Download


Você pode baixar A pasta de trabalho exemplo (emfrancês).
No entanto, se ele não estiver mais disponível no cijoint, favor me avisar, enviando-me um MP [communaute/profil-pijaku aqui, clique em "Escrever uma mensagem"]



Tradução feita por Lucia Maurity y Nouira
Para uma leitura offline, é possível baixar gratuitamente este artigo no formato PDF:
Vba-excel-mover-qualquer-tipo-de-arquivo.pdf

Veja também

Na mesma categoria

Excel/VBA - Move all types of files
Por deri58 em 17 de outubro de 2011
VBA - Excel Déplacer tous types de fichiers
Por pijaku em 14 de outubro de 2011
Artigo original publicado por pijaku. Tradução feita por pintuda.
Este documento, intitulado « VBA - Excel Mover qualquer tipo de arquivo »a partir de CCM (br.ccm.net) está disponibilizado sob a licença Creative Commons. Você pode copiar, modificar cópias desta página, nas condições estipuladas pela licença, como esta nota aparece claramente.