MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

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

    [Resolvido]Renomear fotos em lote

    Compartilhe

    helio_japa
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 6
    Registrado : 11/07/2012

    [Resolvido]Renomear fotos em lote

    Mensagem  helio_japa em Ter 23 Dez 2014, 10:20

    Bom dia a todos do fórum, estou precisando de uma ajuda da selva, acontece o seguinte a matricula dos pacientes aqui do hospital esta para virar em um milhão Ex:1.000.000 e as fotos estão salvas em uma pasta chamada FotosPacientes no formato Ex:123456.jpg ae neste caso preciso acrescentar em todas as matrículas um zero a esquerda ficando neste formato Ex: 0123456.jpg portanto de 10 digitos para 11 digitos.
    Estou tentando este procedimento mas na linha aonde vai renomear a foto "Name filesOrig As filesDest" me aparece uma msg de errro 53 dizendo não encontrar o arquivo. Obrigado desde já e um Feliz Natal a todos!!

    Function RenomeaFoto ()
    Dim filesOrig As Variant
    Dim filesDest As Variant
    Dim carac as Interger

    filesOrig = Dir("C:\FotosPacientes\" & "*.jpg", vbArchive)
    filesDest = Dir("C:\FotosPacientes\" & "*.jpg", vbArchive)
       
       While filesOrig <> "" ' inicia o loop no diretório listando todos os arquivos
            carac = Len(filesOrig) ' conta os caracteres da matricula
            If carac = 10 Then
                Debug.Print filesOrig ' mostra arquivos na verificação imediata Ctrl+G
                filesOrig = Dir(, vbArchive)
                filesDest = Dir(, vbArchive)
                filesOrig = "0" & filesDest
                Name filesOrig As filesDest
       Wend
            End if  
    End Function

    LiveBrain
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 182
    Registrado : 15/05/2011

    Re: [Resolvido]Renomear fotos em lote

    Mensagem  LiveBrain em Ter 23 Dez 2014, 12:13

    Opa meu amigo, tentei rodar sua function mas apresentou muitos erros...
    tenta esse código. Faça um teste antes em uma pasta com menos fotos pra ver se é isso mesmo que precisa


    Código:
    Public Sub RenomeaFoto ()
     
        Dim Caminho As String
        Caminho = "Aqui é a sua pasta de fotos"
     
        Dim FSO As Object, Pasta As Object, Arquivo As Object, Arquivos As Object
        Dim stNewFile As String
     
        Set FSO = CreateObject("Scripting.FileSystemObject")
     
        Set Pasta = FSO.GetFolder(Caminho)
        Set Arquivos = Pasta.Files
        For Each Arquivo In Arquivos
            stNewFile = Caminho & "\0" & Arquivo.Name
            Name Arquivo.Path As stNewFile
            doEvents
        Next
       
    End Sub


    .................................................................................
    Abraços

    Live Brain Tutoriais

    "Fraca é a pessoa que não conhece a força que possui nos amigos"

    helio_japa
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 6
    Registrado : 11/07/2012

    Re: [Resolvido]Renomear fotos em lote

    Mensagem  helio_japa em Ter 23 Dez 2014, 12:46

    Live Brain bom dia!!!
    Meu amigo você acertou na mosca a minha necessidade, parabéns pelo seu empenho e iniciativa em poder ajudar esta humilde colega no meio dessa selva. Rodou lindo!!!
    Como eu não tenho muito conhecimento de VBA como você e no meio de tantas feras gostaria de fazer mais um pedido, se não fosse abusar, é o seguinte teria como neste procedimento checar se a matricula do paciente tem 10 caracteres e se tiver acrescentar o zero a esquerda tornando 11 caracteres e se as matriculas que estiverem já com 11 caracteres não fazer nada.
    É que nesta pasta já existe algumas fotos com 11 caracteres e não poderia acrescentar.
    Abraços e Feliz Natal e muito obrigado!!!

    helio_japa
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 6
    Registrado : 11/07/2012

    Re: [Resolvido]Renomear fotos em lote

    Mensagem  helio_japa em Ter 23 Dez 2014, 13:31

    Após algumas tentativas consegui adaptar o procedimento para atender a minha necessidade de renomear apenas fotos com 10 caracteres:

    Public Sub RenomeaFoto ()
    Dim Caminho As String
    Dim car As Integer
    Caminho = "C:\FotosdePacientes\"

    Dim FSO As Object, Pasta As Object, Arquivo As Object, Arquivos As Object
    Dim stNewFile As String



    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Pasta = FSO.GetFolder(Caminho)
    Set Arquivos = Pasta.files

    For Each Arquivo In Arquivos
    car = Len(Arquivo)
    If car = 25 Then
    stNewFile = Caminho & "\0" & Arquivo.Name
    Name Arquivo.Path As stNewFile
    DoEvents
    End If
    Next
    End Sub

      Data/hora atual: Sex 09 Dez 2016, 07:40