VBA - Excel Mover qualquer tipo de arquivo


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"]


Artigo original publicado por deri58. Tradução feita por pintuda. Última modificação: 15 de outubro de 2011 às 08:29 por pintuda.
Este documento, intitulado 'VBA - Excel Mover qualquer tipo de arquivo', está disponível sob a licença Creative Commons. Você pode copiar e/ou modificar o conteúdo desta página com base nas condições estipuladas pela licença. Não se esqueça de creditar o CCM (https://br.ccm.net/) ao utilizar este artigo.
Colocar duas condições em uma mesma célula no Excel 2007
VBA & Excel: ler em uma planilha fechada