MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    [Resolvido]Alterar nome de arquivo

    avatar
    Belobo
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 54
    Registrado : 12/07/2014

    [Resolvido]Alterar nome de arquivo Empty [Resolvido]Alterar nome de arquivo

    Mensagem  Belobo em Qui 04 Jun 2020, 22:34

    Boa noite
    Preciso de um VBA para alterar arquivos de um diretório C:\ extensão.jpg
    Exemplo
    123456-022-09.jpg
    654321-9080-99.jpg

    Preciso que os arquivos sejam alterados para
    123456-022.jpg
    654321-9089.jpg

    Os arquivos não tem mesma qtde de caracteres por isso precisamos que a alteração seja a partir do segundo hífen
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2136
    Registrado : 21/11/2016

    [Resolvido]Alterar nome de arquivo Empty Re: [Resolvido]Alterar nome de arquivo

    Mensagem  DamascenoJr. em Qui 04 Jun 2020, 23:37

    Renomear arquivos foi um tema tratado recentemente no fórum.

    Veja se o tópico ajuda
    https://www.maximoaccess.com/t37816-resolvidorenomear-varios-arquivos-em-funcao-dos-registos-da-tabela


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    avatar
    Belobo
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 54
    Registrado : 12/07/2014

    [Resolvido]Alterar nome de arquivo Empty Re: [Resolvido]Alterar nome de arquivo

    Mensagem  Belobo em Sex 05 Jun 2020, 11:40

    Como sou usuário avançado sem curso de programação entendo que este exemplo irá me ajudar quando tenho um banco de dados interno com tabelas etc
    O que desejo é entra num diretório externo ver os arquivos JPG existentes e alterar o nome conforme exemplifiquei
    Se puder ajudar agradeço e solicito ao grupo também
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2136
    Registrado : 21/11/2016

    [Resolvido]Alterar nome de arquivo Empty Re: [Resolvido]Alterar nome de arquivo

    Mensagem  DamascenoJr. em Sex 05 Jun 2020, 23:17

    Isso remove o segundo hífen e tudo que vier depois dele. Basta apontar a pasta.

    Código:
    Dim strCaminho As String
       
        'strCaminho = "\\PastaNaRede\"
        strCaminho = "X:\PastaEmDisco\"
       
        '--------------------------------------------------------------------

        Const STR_FORMATO As String = ".jpg"

        Dim strArquivo1 As String
        Dim strArquivo2 As String
        Dim arrArquivo() As String
        Dim intContador As Integer

        ReDim Preserve arrArquivo(0)
        strArquivo1 = Dir(strCaminho & "*" & STR_FORMATO, vbArchive)

        Do While strArquivo1 <> ""
       
            strArquivo2 = Left(strArquivo1, Len(strArquivo1) - Len(STR_FORMATO))
           
            If UBound(Split(strArquivo2, "-")) > 1 Then
                If arrArquivo(0) = "" Then
                    arrArquivo(0) = strArquivo2
                Else
                    ReDim Preserve arrArquivo(UBound(arrArquivo) + 1)
                    arrArquivo(UBound(arrArquivo)) = strArquivo2
                End If
            End If
       
            strArquivo1 = Dir()
       
        Loop
       
        If arrArquivo(0) <> "" Then
            For intContador = 0 To UBound(arrArquivo)
                Name strCaminho & arrArquivo(intContador) & STR_FORMATO _
                As strCaminho & Split(arrArquivo(intContador), "-")(0) & "-" & Split(arrArquivo(intContador), "-")(1) & STR_FORMATO
            Next intContador
        End If
       
        Call MsgBox(intContador & " arquivo(s) renomeados.", vbInformation, "Informação")


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    avatar
    Belobo
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 54
    Registrado : 12/07/2014

    [Resolvido]Alterar nome de arquivo Empty Re: [Resolvido]Alterar nome de arquivo

    Mensagem  Belobo em Sab 06 Jun 2020, 01:50

    O comando esta me parecendo que vai rodar bacana .
    Gostaria de um ajuste se for viavel . Estou solicitando pois realmente nao sei como fazer
    Acontece o seguinte quando o VBA encontra um arquivo repetido ele para de rodar dizendo a seguinte mensagem : Erro em tempo de execucao 58 - o arquivo ja existe.
    Teria como encaixar um comando para sobreescrever o arquivo quando isso acontecer ao inves de parar o comando ?
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2136
    Registrado : 21/11/2016

    [Resolvido]Alterar nome de arquivo Empty Re: [Resolvido]Alterar nome de arquivo

    Mensagem  DamascenoJr. em Sab 06 Jun 2020, 17:45

    ...
    Código:
    Dim strCaminho As String
       
        'strCaminho = "\\PastaNaRede\"
        strCaminho = "X:\PastaEmDisco\"
       
        '--------------------------------------------------------------------

        Const STR_FORMATO As String = ".jpg"

        Dim strArquivo1 As String
        Dim strArquivo2 As String
        Dim arrArquivo() As String
        Dim intContador As Integer

        ReDim Preserve arrArquivo(0)
        strArquivo1 = Dir(strCaminho & "*" & STR_FORMATO, vbArchive)

        Do While strArquivo1 <> ""
       
            strArquivo2 = Left(strArquivo1, Len(strArquivo1) - Len(STR_FORMATO))
           
            If UBound(Split(strArquivo2, "-")) > 1 Then
                If arrArquivo(0) = "" Then
                    arrArquivo(0) = strArquivo2
                Else
                    ReDim Preserve arrArquivo(UBound(arrArquivo) + 1)
                    arrArquivo(UBound(arrArquivo)) = strArquivo2
                End If
            End If
       
            strArquivo1 = Dir()
       
        Loop
       
        If arrArquivo(0) <> "" Then
            For intContador = 0 To UBound(arrArquivo)
                strArquivo1 = strCaminho & Split(arrArquivo(intContador), "-")(0) & "-" & Split(arrArquivo(intContador), "-")(1) & STR_FORMATO
                If Dir(strArquivo1, vbArchive) <> "" Then Call Kill(strArquivo1)
                Name strCaminho & arrArquivo(intContador) & STR_FORMATO _
                As strArquivo1
            Next intContador
        End If
       
        Call MsgBox(intContador & " arquivo(s) renomeados.", vbInformation, "Informação")


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    avatar
    Belobo
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 54
    Registrado : 12/07/2014

    [Resolvido]Alterar nome de arquivo Empty Re: [Resolvido]Alterar nome de arquivo

    Mensagem  Belobo em Dom 07 Jun 2020, 06:04

    Meu amigo muito obrigado
    Tudo funcionou certinho
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2136
    Registrado : 21/11/2016

    [Resolvido]Alterar nome de arquivo Empty Re: [Resolvido]Alterar nome de arquivo

    Mensagem  DamascenoJr. em Dom 07 Jun 2020, 08:34

    O fórum agradece o retorno. Sucesso.


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    avatar
    Belobo
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 54
    Registrado : 12/07/2014

    [Resolvido]Alterar nome de arquivo Empty Comando para sobescrever arquivo

    Mensagem  Belobo em Seg 08 Jun 2020, 04:58

    Amigos tenho esse comando que altera o nome de arquivos existentes numa determinada pasta
    Acontece que quando o arquivo ja existe ele trava a continuidade do comando
    poderia me ajudar a encaixar um comando que sobrescreva o arquivo existente

    segue vba

    Private Sub Comando0_Click()
    Dim myfile As String, newFile As String
    Dim myfolder As String

    myfolder = "C:\Users\Samsung\Downloads\"

    myfile = Dir(myfolder & "*.jpg")
    While myfile <> ""
    newName = Left(myfile, 7) & ".jpg"
    Name myfolder & myfile As myfolder & newName

    'code here to copy the fiel to another location
    'filecopy myFolder & newName, destFolder & newName
    myfile = Dir
    Wend

    End Sub
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2136
    Registrado : 21/11/2016

    [Resolvido]Alterar nome de arquivo Empty Re: [Resolvido]Alterar nome de arquivo

    Mensagem  DamascenoJr. em Seg 08 Jun 2020, 18:57

    Tópico fundido. Mesmo autor, mesmas dúvidas.


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2136
    Registrado : 21/11/2016

    [Resolvido]Alterar nome de arquivo Empty Re: [Resolvido]Alterar nome de arquivo

    Mensagem  DamascenoJr. em Seg 08 Jun 2020, 19:03

    Veja, usei a mesma lógica do comando anterior que já foi mostrado e lhe serviu

    Private Sub Comando0_Click()
    Dim myfile As String, newFile As String
    Dim myfolder As String

    myfolder = "C:\Users\Samsung\Downloads\"

    myfile = Dir(myfolder & "*.jpg")
    While myfile <> ""
    newName = Left(myfile, 7) & ".jpg"

    'se na pasta já houver um arquivo com o nome do novo arquivo então
    if dir(myFolder & newName) <> "" then
       'apague esse arquivo que já existe
       call kill(myFolder & newName)
    end if

    'renomeando o arquivo com a certeza de que não haverá um outro arquivo com o novo nome
    Name myfolder & myfile As myfolder & newName

    'code here to copy the fiel to another location
    'filecopy myFolder & newName, destFolder & newName
    myfile = Dir
    Wend

    End Sub


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    avatar
    Belobo
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 54
    Registrado : 12/07/2014

    [Resolvido]Alterar nome de arquivo Empty Re: [Resolvido]Alterar nome de arquivo

    Mensagem  Belobo em Seg 08 Jun 2020, 20:04

    Concordo bem parecido mas na minha visão de usuário jamais eu conseguiria
    Agora já tenho uma base com separadores e também com as funcoes left Right e Mid que nesse segundo exemplo posso trocar quando necessário
    Mas sendo sincero eu não conseguiria desvendar essa segunda opção que fez pois apesar de parecida não e igual !
    Vou testar e agradeço sua atenção . Depois eu dou como resolvido quando testar !!
    avatar
    Belobo
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 54
    Registrado : 12/07/2014

    [Resolvido]Alterar nome de arquivo Empty Re: [Resolvido]Alterar nome de arquivo

    Mensagem  Belobo em Seg 08 Jun 2020, 22:15

    Utilizando o codigo apresentado temos um erro abaixo

    Erro em tempo de execucao '5'
    Argumento ou chamada de procedimento invalida
    a depuracao para no myfile = Dir
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2136
    Registrado : 21/11/2016

    [Resolvido]Alterar nome de arquivo Empty Re: [Resolvido]Alterar nome de arquivo

    Mensagem  DamascenoJr. em Seg 08 Jun 2020, 22:27

    A parte que eu adicionei não afeta esse trecho do código. Retire a parte do código que eu adicionei e veja se seu novo código funciona com perfeição.

    Ou então substitua o seu novo código pelo código que eu criei inicialmente.


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    avatar
    Belobo
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 54
    Registrado : 12/07/2014

    [Resolvido]Alterar nome de arquivo Empty Re: [Resolvido]Alterar nome de arquivo

    Mensagem  Belobo em Seg 08 Jun 2020, 22:37

    Quando eu coloco o meu codigo inicial o erro apresentador é file exists e trava o codigo

    Copiando seu codigo ajustado da essa mensagem de erro que mencionei

    Nao tenho condicoes de avaliar o que se trata isso infelizmente
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2136
    Registrado : 21/11/2016

    [Resolvido]Alterar nome de arquivo Empty Re: [Resolvido]Alterar nome de arquivo

    Mensagem  DamascenoJr. em Ter 09 Jun 2020, 12:14

    Adaptando o código da mensagem número 6

    Código:
    Dim strCaminho As String
     
        'strCaminho = "\\PastaNaRede\"
        strCaminho = "X:\PastaEmDisco\"
     
        '--------------------------------------------------------------------

        Const STR_FORMATO As String = ".jpg"

        Dim strArquivo1 As String
        Dim strArquivo2 As String
        Dim arrArquivo() As String
        Dim intContador As Integer

        ReDim Preserve arrArquivo(0)
        strArquivo1 = Dir(strCaminho & "*" & STR_FORMATO, vbArchive)

        Do While strArquivo1 <> ""
     
            strArquivo2 = Left(strArquivo1, Len(strArquivo1) - Len(STR_FORMATO))
         
                If arrArquivo(0) = "" Then
                    arrArquivo(0) = strArquivo2
                Else
                    ReDim Preserve arrArquivo(UBound(arrArquivo) + 1)
                    arrArquivo(UBound(arrArquivo)) = strArquivo2
                End If
     
            strArquivo1 = Dir()
     
        Loop
     
        If arrArquivo(0) <> "" Then
            For intContador = 0 To UBound(arrArquivo)
                strArquivo1 = strCaminho & left(arrArquivo(intContador), 7) & STR_FORMATO
                If Dir(strArquivo1, vbArchive) <> "" Then Call Kill(strArquivo1)
                Name strCaminho & arrArquivo(intContador) & STR_FORMATO _
                As strArquivo1
            Next intContador
        End If
     
        Call MsgBox(intContador & " arquivo(s) renomeados.", vbInformation, "Informação")


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.

      Data/hora atual: Qua 05 Ago 2020, 15:40