MaximoAccess

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

Obrigado

Administração do MaximoAccess

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

    [Resolvido]Renomear fotos em lote

    Compartilhe
    avatar
    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, 08: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
    avatar
    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, 10: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"
    avatar
    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, 10: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!!!
    avatar
    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, 11: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: Sab 18 Nov 2017, 11:55