none
Renomear Ficheiros RRS feed

  • Pergunta

  • Bom dia.

    Preciso de ajuda na seguinte questão:

    O Listbox1 exibe espécies e o Listbox2 exibe as subespécies que será também o nome principal dos ficheiros contidos numa pasta.

    No entanto quando os ficheiros de imagem são copiados para a pasta, têm uma estrutura diferente, sendo as duas palavras do nome do arquivo, separados por vários símbolos gráficos, que podem ser "-", "_", "." ou mais que 1 espaço.

    A finalidade, é obter uma estrutura uniforme em todos os ficheiros.

    Assim, se um ficheiro tem o nome: "Abortiporus_biennis_538.jpg" e "abortiporus-biennis - acf45.jpg", deverá ser alterado para:

    "Abortiporus biennis-538.jpg" e "Abortiporus biennis-acf45.jpg"

    Portanto, na nova estrutura:

    1º - A 1ª letra é sempre Maiúscula e as restantes minúsculas.

    2º - Deverá existir sempre um espaço entre ambos os termos do nome completo.

    3º - Deverá existir sempre um "-" (hífen) antes da referência do arquivo.

    Tenho utilizado a rotina seguinte disponibilizada por Felipe Gualberto num outro tópico e que funciona bem para substituição dos primeiros dois termos.

    Porém, embora já tenha funcionado para a separação da referência, já não faz as alterações desejadas.

    O que poderá estar errado?

    Private Sub CommandButton3_Click()
    Dim SearchPath As String
        Dim iDir As String
        Dim fso As Object 'Scripting.FileSystemObject
        Dim iFile As Object 'Scripting.File
        
        Set fso = CreateObject("Scripting.FileSystemObject")
        
        For Each iFile In fso.GetFolder(ThisWorkbook.Path & "\FOTOS_A_ALTERAR\").Files
            If Not LCase(iFile.Name) Like "*" & ListBox2.Value & "_*" Then GoTo REPETE
                 fso.MoveFile iFile.Path, Replace(iFile.Path, ListBox2.Value & "_", ListBox2.Value & "-")
                 fso.MoveFile iFile.Path, Replace(iFile.Path, ListBox2.Value & " - ", ListBox2.Value & "-")
                 fso.MoveFile iFile.Path, Replace(iFile.Path, ListBox2.Value & " ", ListBox2.Value & "-")
    
    REPETE:
            If UCase(iFile.Name) Like "*" & ListBox2.Value & "_*" Then GoTo Continue
                 fso.MoveFile iFile.Path, Replace(iFile.Path, ListBox2.Value & "_", ListBox2.Value & "-")
                 On Error Resume Next
                 fso.MoveFile iFile.Path, Replace(iFile.Path, ListBox2.Value & " - ", ListBox2.Value & "-")
    
    Continue:
                 fso.MoveFile iFile.Path, Replace(iFile.Path, ListBox2.Value & "_", ListBox2.Value & "-")
                 fso.MoveFile iFile.Path, Replace(iFile.Path, ListBox2.Value & " - ", ListBox2.Value & "-")
                 fso.MoveFile iFile.Path, Replace(iFile.Path, ListBox2.Value & " ", ListBox2.Value & "-")
        Next iFile
    
    End Sub
    

    Antecipadamente grato pela ajuda.

    Cumprimentos


    M_A_S_L

    sábado, 17 de fevereiro de 2018 12:18

Respostas

  • Option Explicit
    
    Sub teste()
    Dim iFile As File
    Dim fso As New FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
        Dim caminho As String
        For Each iFile In fso.GetFolder(ThisWorkbook.Path & "\FOTOS_A_ALTERAR\").Files
        caminho = Replace(iFile.Name, "_", "-")
        caminho = UCase(Left(caminho, 1)) & LCase(Right(caminho, Len(caminho) - 1))
    
            If Left(iFile.Name, Len(ListBox2.Value)) = ListBox2.Value Then
                fso.MoveFile iFile.Path, ThisWorkbook.Path & "\FOTOS_A_ALTERAR\" & caminho
                MsgBox "O novo caminho do arquivo é: " & vbCrLf & ThisWorkbook.Path & "\FOTOS_A_ALTERAR\" & caminho
            Else
                GoTo Continue
            End If
    Continue:
        Next iFile
        
    End Sub
    
    Private Sub CommandButton1_Click()
    Call teste
    End Sub
    
    Private Sub UserForm_Click()
    
    End Sub
    
    Private Sub UserForm_Initialize()
    Me.ListBox2.AddItem ("Arquivo_De_Teste")
    End Sub
    


    A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    • Marcado como Resposta M_A_S_L domingo, 18 de fevereiro de 2018 16:32
    domingo, 18 de fevereiro de 2018 15:21

Todas as Respostas

  • Anderson, obrigado pela resposta, mas não é o caso.

    Trata-se de um nome de um ficheiro cuja estrutura tem mesmo que ser respeitada, pois trata-se do nome científico de um fungo.

    De qualquer forma a comparação é feita na íntegra, pois quando digo:

     If Not LCase(iFile.Name) Like "*" & ListBox2.Value & "_*" Then

    Listbox2.value define por completo o termo de comparação conforme podes ver na imagem que inseri.

    Apenas junto à cadeia de carateres o símbolo  "_" e que pode ser outro para que na renomeação a rotina pegue em "Listbox2.value_" e renomeie para "Listbox2.value-". Retirando do exemplo que postei, preciso de renomear de "Abortiporus biennis_aaa" para "Abortiporus biennis-aaa".

    Assim, a linha

     fso.MoveFile iFile.Path, Replace(iFile.Path, ListBox2.Value & "_", ListBox2.Value & "-")

    deveria fazer essa alteração nos nomes. Só que não faz, fruto eventualmente da ausência da sintaxe correta.

    Porém não me apresenta qualquer erro mesmo retirando as linhas de On Error Resume Next.

    A mesma estrutura de código é utilizada para retirar carateres entre os dois primeiros termos do nome do ficheiro e funciona 5 estrelas.

    Estou farto de dar voltas ao código e não consigo descobrir porque me faz a comparação entre Listbox1.value de forma exata e não me faz a comparação entre Listbox2.value.

    Cumprimentos


    M_A_S_L

    sábado, 17 de fevereiro de 2018 21:35
  • Olá Anderson.

    If Not LCase(iFile.Name) Like "*" & ListBox2.Value & "_*" Then

    Traduzindo para Português, diz que se não for minúscula ... then vai para o próximo ficheiro. Portanto significa apenas que não precisa de ser alterado pois já se encontra como deve. Em caso contrário executa as linhas a seguir, se encontrar a 1ª letra com minúsculas, procedendo à alteração necessária.

    Aqui o código executa-se na perfeição.

    Também o "iFile.Name" quando é lido, deve conter como "valor" "Abortiporus biennis_aaa", portanto perfeitamente comparável a Listbox2.value, cujo "valor" é "Abortiporus biennis" & "_*".

    Vou no entanto experimentar a comparação dos dois termos com LCase embora não me pareça que vá surtir efeito, pois o termo "Like" não me parece diferenciar maiúsculas de minúsculas, daí a necessidade de especificar o nome antes e o nome depois.

    Tirar o "_" é impensável pois são mais de 9000 imagens, 90% delas com o Underline. São imagens que retiro da Internet e que portanto trazem estruturas diversas. Por questões de tempo guardo sem alterar nomes.

    Penso que o problema deverá estar nas linhas de "Replace".

    Uma boa noite.

     


    M_A_S_L



    • Editado M_A_S_L sábado, 17 de fevereiro de 2018 23:20
    sábado, 17 de fevereiro de 2018 23:14
  • A tradução foi aplicada ao exemplo em causa em que a única diferença é a letra maiúscula e a minúscula, o underline e a refª do arquivo ainda não renomeado.

    Mas...

    "Se o nome do arquivo convertido, não for nada parecido com o texto da listbox."

    Esta parte não percebi. Like não significa parecido, semelhante, similar ou algo do género?

    E o "Not" não se aplica apenas ao LCase?


    M_A_S_L

    sábado, 17 de fevereiro de 2018 23:44
  • Obrigado pelas suas respostas e esclarecimentos.

    Só depois de postar reparei que se referia ao código e não aos arquivos. Vou agora olhar o código com outros olhos e ver o que consigo apurar tentando da várias formas que postou.

    Tenha uma boa noite.


    M_A_S_L

    domingo, 18 de fevereiro de 2018 01:09
  • Bom dia.

    Tentei assim:

        Set fso = CreateObject("Scripting.FileSystemObject")
        
        For Each iFile In fso.GetFolder(ThisWorkbook.Path & "\FOTOS_A_ALTERAR\").Files
            If Left(iFile.Name, Len(ListBox2.Value)) = ListBox2.Value Then
                fso.MoveFile iFile.Path, Replace(iFile.Path, ListBox2.Value & "_", ListBox2.Value & "-")
            Else
                GoTo Continue
            End If
    Continue:
        Next iFile
    

    Não altera os arquivos.

    Tentei concatenando ambos os membros da igaldade e ... nada.

    Tentei de varias outras formas sem resultados.

    Mas não vou desistir.

    Vou tentar descobrir uma forma porque ela anda por aí algures.


    M_A_S_L

    domingo, 18 de fevereiro de 2018 12:48

  • A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    domingo, 18 de fevereiro de 2018 14:26

  • A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    domingo, 18 de fevereiro de 2018 14:50

  • A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    domingo, 18 de fevereiro de 2018 14:51

  • A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    domingo, 18 de fevereiro de 2018 14:53
  • Option Explicit
    
    Sub teste()
    Dim iFile As File
    Dim fso As New FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
        Dim caminho As String
        For Each iFile In fso.GetFolder(ThisWorkbook.Path & "\FOTOS_A_ALTERAR\").Files
        caminho = Replace(iFile.Name, "_", "-")
    
            If Left(iFile.Name, Len(ListBox2.Value)) = ListBox2.Value Then
                fso.MoveFile iFile.Path, ThisWorkbook.Path & "\FOTOS_A_ALTERAR\" & caminho
                MsgBox "O novo caminho do arquivo é: " & vbCrLf & ThisWorkbook.Path & "\FOTOS_A_ALTERAR\" & caminho
            Else
                GoTo Continue
            End If
    Continue:
        Next iFile
        
    End Sub
    
    Private Sub CommandButton1_Click()
    Call teste
    End Sub
    
    Private Sub UserForm_Click()
    
    End Sub
    
    Private Sub UserForm_Initialize()
    Me.ListBox2.AddItem ("Arquivo_De_Teste")
    End Sub
    


    A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    domingo, 18 de fevereiro de 2018 14:54
  • Option Explicit
    
    Sub teste()
    Dim iFile As File
    Dim fso As New FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
        Dim caminho As String
        For Each iFile In fso.GetFolder(ThisWorkbook.Path & "\FOTOS_A_ALTERAR\").Files
        caminho = Replace(iFile.Name, "_", "-")
        caminho = UCase(Left(caminho, 1)) & LCase(Right(caminho, Len(caminho) - 1))
    
            If Left(iFile.Name, Len(ListBox2.Value)) = ListBox2.Value Then
                fso.MoveFile iFile.Path, ThisWorkbook.Path & "\FOTOS_A_ALTERAR\" & caminho
                MsgBox "O novo caminho do arquivo é: " & vbCrLf & ThisWorkbook.Path & "\FOTOS_A_ALTERAR\" & caminho
            Else
                GoTo Continue
            End If
    Continue:
        Next iFile
        
    End Sub
    
    Private Sub CommandButton1_Click()
    Call teste
    End Sub
    
    Private Sub UserForm_Click()
    
    End Sub
    
    Private Sub UserForm_Initialize()
    Me.ListBox2.AddItem ("Arquivo_De_Teste")
    End Sub
    


    A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    • Marcado como Resposta M_A_S_L domingo, 18 de fevereiro de 2018 16:32
    domingo, 18 de fevereiro de 2018 15:21
  • Option Explicit
    
    Sub teste2()
    Dim iFile As File
    Dim fso As New FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
        Dim caminho As String
        For Each iFile In fso.GetFolder(ThisWorkbook.Path & "\FOTOS_A_ALTERAR\").Files
        caminho = Replace(iFile.Name, "_", "-")
        caminho = UCase(Left(caminho, 1)) & LCase(Right(caminho, Len(caminho) - 1))
    
           ' If Left(iFile.Name, Len(ListBox2.Value)) = ListBox2.Value Then
                fso.MoveFile iFile.Path, ThisWorkbook.Path & "\FOTOS_A_ALTERAR\" & caminho
               ' MsgBox "O novo caminho do arquivo é: " & vbCrLf & ThisWorkbook.Path & "\FOTOS_A_ALTERAR\" & caminho
            'Else
              '  GoTo Continue
           ' End If
    'Continue:
        Next iFile
        
    End Sub
    
    


    A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    domingo, 18 de fevereiro de 2018 15:23
  • https://drive.google.com/file/d/1hUC-lx2kVmRITXvVfEMLR-sPGTMvdifB/view?usp=sharing

    A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    domingo, 18 de fevereiro de 2018 15:31
  • Bom dia Anderson.

    Obrigado pela sua paciência e por disponibilizar os seus conhecimentos numa matéria, que por não ter formação informática  me dificulta o entendimento de certas coisas. (O pouco que sei aprendi sozinho com pesquisas e ajudas).

    Os ensinamentos que me passou,não cairam em saco roto e estão guardados na minha biblioteca de códigos, para com calma estudar e analizar tentando entender o que cada coisa significa.

    As rotinas que postou, embora ainda não as tenha testado, também as tentei adaptar sem sucesso e retirei o código do forum "stakoverflow". O problema? A rotina ou convertia tudo em maiúsculas ou tudo em minúsculas.

    No entanto como lhe disse, os seus ensinamentos não foram em vão.

    Mas eu sabia que a solução estava próxima e hoje de manhã, com a cabeça fresca, comecei a pensar ao contrário (comecei a pensar Not ... Like).

    E então, cheguei a isto:

    Private Sub CommandButton3_Click()

    Dim SearchPath As String Dim iDir As String, NOME_U2 As String Dim fso As Object 'Scripting.FileSystemObject Dim iFile As Object 'Scripting.File Set fso = CreateObject("Scripting.FileSystemObject") For Each iFile In fso.GetFolder(ThisWorkbook.Path & "\FOTOS_A_ALTERAR\").Files If Not LCase(iFile.Name) Like ListBox2.Value & "_*" Then GoTo REPETE fso.MoveFile iFile.Path, Replace(iFile.Path, ListBox2.Value & "_", ListBox2.Value & "-") REPETE: If UCase(iFile.Name) Like "*" & ListBox2.Value & "_*" Then GoTo Continue fso.MoveFile iFile.Path, Replace(iFile.Path, ListBox2.Value & "_", ListBox2.Value & "-") Continue: Next iFile End sub

    E fês-se luz. Tudo funciona direitinho como se pretende.

    -1ª letra em maiúsculas,

    -Restantes letras em minúsculas,

    -Um espaço a separar Espécie e Subespécie,

    -Refª final do arquivo separada por Hífen.

    Se me perguntar exatamente como a rotina faz as coisas, eu não lhe sei responder, mas foi-me disponibilizada por um grande moderador, FELIPE GUALBERTO, e eu apenas a adaptei à minha necessidade.

    Esta tarefa é bastante mais complicada quando se não têm os conhecimentos, a arte e o engenho.

    Baixei o seu ficheiro do link que disponibilizou, e vou testar as suas rotinas, pois tentei de forma muito semelhante, mas claro está que faltou alguma coisa pois não me resolveu o problema.

    Agradeço no entanto (e nunca é demais dizê-lo), todo o seu empenhamento e ajuda.

    Um grande obrigado.


    M_A_S_L




    • Editado M_A_S_L domingo, 18 de fevereiro de 2018 16:31
    domingo, 18 de fevereiro de 2018 16:19