MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

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


2 participantes

    [Resolvido]Mover arquivos e salvar o diretório Destino

    Thearles
    Thearles
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 36
    Registrado : 26/12/2011

    [Resolvido]Mover arquivos e salvar o diretório Destino Empty [Resolvido]Mover arquivos e salvar o diretório Destino

    Mensagem  Thearles 11/1/2015, 18:12

    Boa tarde a todos, sou novo com o Access e VBA e tenho uma dúvida sobre o seguinte código:

    Private Sub lstOpcao_DblClick(Cancel As Integer)
    Me.Foto.Picture = Me.lstOpcao.Column(1)
    Dim fso
    Dim file As String, sfol As String, dfol As String
    file = Me.lstOpcao.Column(1) ' nome do ficheiro
    sfol = "C:\Users\Usuario\Desktop\Em uso2\Temporario\" ' caminho inicial
    dfol = "C:\Users\Usuario\Desktop\Em uso2\Globo\" ' caminho destino
    Set fso = CreateObject("Scripting.FileSystemObject")
      If Not fso.FileExists(file) Then
                    MsgBox file & " não existe!", vbExclamation, "Erro"
      ElseIf Not fso.FileExists(dfol & file) Then
                    fso.MoveFile (file), dfol
            Else
                    MsgBox dfol & file & " existente!", vbExclamation, "Sucesso"
                    End If
    DoCmd.SetWarnings False
    DoCmd.RunSQL "UPDATE Tabela1 SET Tabela1.LocalFoto = '" & Me.lstOpcao.Column(1) & "' WHERE Tabela1.Código=" & Me.Código
    DoCmd.SetWarnings True
    Me.btnAddFoto.SetFocus
    Me.lstOpcao.Visible = False
    End Sub

    Eu utilizo este código para listar as imagens que estão na pasta "Temporario", escolher uma delas, tranferir a imagem escolhida para a pasta "Globo" e gravar em uma tabela o endereço (pasta do PC) para onde foi transferida a imagem. Embora ele não gere nenhum erro, não me atende , pois na linha
    DoCmd.RunSQL "UPDATE Tabela1 SET Tabela1.LocalFoto = '" & Me.lstOpcao.Column(1) & "' WHERE Tabela1.Código=" & Me.Código
    o comando grava o endereço onde estava a imagem (no caso a pasta "Temporario") e não o endereço para onde a imagem foi transferida ("Globo"). Sei que devo alterar a parte Me.lstOpcao.Column(1) na referida linha acima, mas não sei fazê-lo, pois tenho de trocá-la pelo endereço novo da imagem, e ele será composto por  C:\Users\Usuario\Desktop\Em uso2 + os 12 últimos dígitos da resposta obtida em Me.lstOpcao.Column(1). Sou grato a quem puder me ajudar. Abraços.
    Noobezinho
    Noobezinho
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 4140
    Registrado : 29/06/2012

    [Resolvido]Mover arquivos e salvar o diretório Destino Empty Re: [Resolvido]Mover arquivos e salvar o diretório Destino

    Mensagem  Noobezinho 12/1/2015, 13:36

    Olá Thearles

    Veja, você definiu o caminho

    Me.Foto.Picture = Me.lstOpcao.Column(1)

    Aqui você definiu a 2ª Coluna  da listbox com o nome da foto, acredito que seja o caminho todo e não só o nome.

    E aqui:

    DoCmd.RunSQL "UPDATE Tabela1 SET Tabela1.LocalFoto = '" & Me.lstOpcao.Column(1) & "' WHERE Tabela1.Código=" & Me.Código

    O código está mandando gravar esse mesmo caminho ou nome na tabela 1

    Para que aconteça o que deseja , experimente assim:

    DoCmd.RunSQL "UPDATE Tabela1 SET Tabela1.LocalFoto = '" & dfol & "' WHERE Tabela1.Código=" & Me.Código

    []'s

    Noob


    .................................................................................
    A pergunta que não quer calar:
    Por quê quando alguém vem pedir ajuda e conforme o caso pedimos
    para enviar parte do projeto, não temos mais continuidade do tópico?  
    Crê que temos bolas de cristal ou está com medo que "roubemos"  a
    idéia/projeto dele?  Twisted Evil
    Se é tão bom assim...


    Ajude a ser ajudado:
    Seja objetivo na dúvida, dê os detalhes do que precisa, sem rodeios.
    Quando anexar teu projeto, diga onde está o problema, ganhamos mais tempo
    sem precisar procurar o mesmo.
    Thearles
    Thearles
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 36
    Registrado : 26/12/2011

    [Resolvido]Mover arquivos e salvar o diretório Destino Empty Re: [Resolvido]Mover arquivos e salvar o diretório Destino

    Mensagem  Thearles 12/1/2015, 21:59

    Olá Noobezinho,

    desde já agradeço a prestatividade. Alterei o código conforme você sugeriu, mas o destino inserido na tabela não ficou completo, faltou o nome da imagem juntamente com o formato (retornou o caminho idêntico ao dfol). Necessito que o código inclua o endereço completo da imagem C:\Users\Usuario\Desktop\Em uso2\Globo\ + XXXXXXX.jpg.
    Noobezinho
    Noobezinho
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 4140
    Registrado : 29/06/2012

    [Resolvido]Mover arquivos e salvar o diretório Destino Empty Re: [Resolvido]Mover arquivos e salvar o diretório Destino

    Mensagem  Noobezinho 12/1/2015, 22:22

    Se nesta linha:

    Me.Foto.Picture = Me.lstOpcao.Column(1)

    for o nome do ficheiro, então ficará assim



    DoCmd.RunSQL "UPDATE Tabela1 SET Tabela1.LocalFoto = '" & dfol  & Me.lstOpcao.Column(1) & "' WHERE Tabela1.Código=" & Me.Código

    Noob


    .................................................................................
    A pergunta que não quer calar:
    Por quê quando alguém vem pedir ajuda e conforme o caso pedimos
    para enviar parte do projeto, não temos mais continuidade do tópico?  
    Crê que temos bolas de cristal ou está com medo que "roubemos"  a
    idéia/projeto dele?  Twisted Evil
    Se é tão bom assim...


    Ajude a ser ajudado:
    Seja objetivo na dúvida, dê os detalhes do que precisa, sem rodeios.
    Quando anexar teu projeto, diga onde está o problema, ganhamos mais tempo
    sem precisar procurar o mesmo.
    Thearles
    Thearles
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 36
    Registrado : 26/12/2011

    [Resolvido]Mover arquivos e salvar o diretório Destino Empty Re: [Resolvido]Mover arquivos e salvar o diretório Destino

    Mensagem  Thearles 12/1/2015, 22:49

    Boa noite,

    então, testei novamente e o endereço retornado fica errado, pois conforme você mesmo disse Me.lstOpcao.Column(1) é um endereço completo, e não apenas o nome da imagem. Imagino que devo usar tipo uma fórmula para extrair de dentro de Me.lstOpcao.Column(1) apenas o nome da figura, que possui 11 caracteres. Só não enviei o banco de dados para você ver porque é muito grande.
    Noobezinho
    Noobezinho
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 4140
    Registrado : 29/06/2012

    [Resolvido]Mover arquivos e salvar o diretório Destino Empty Re: [Resolvido]Mover arquivos e salvar o diretório Destino

    Mensagem  Noobezinho 12/1/2015, 23:48

    Cole a função abaixo num módulo básico

    Public Function SplitFile(CaminhoCompleto As String, Retorna As Boolean) As String
    On Error Resume Next
       Dim Diretório, Arquivo As String
       Dim total As Long
       total = Len(CaminhoCompleto)
       Do While total > 0
           If Mid$(CaminhoCompleto, total, 1) <> "\" Then
               Arquivo = Mid(CaminhoCompleto, total, 1) & Arquivo
               total = total - 1
           Else
               Diretório = Mid(CaminhoCompleto, 1, total)
               Exit Do
           End If
       Loop
       If Retorna = False Then
           SplitFile = Diretório
       Else
           SplitFile = Arquivo
       End If
    End Function



    Copie e cole

    DoCmd.RunSQL "UPDATE Tabela1 SET Tabela1.LocalFoto = '" & dfol & SplitFile(Me.lstOpcao.Column(1),True) & "' WHERE Tabela1.Código=" & Me.Código

    Experimente agora

    Noob


    .................................................................................
    A pergunta que não quer calar:
    Por quê quando alguém vem pedir ajuda e conforme o caso pedimos
    para enviar parte do projeto, não temos mais continuidade do tópico?  
    Crê que temos bolas de cristal ou está com medo que "roubemos"  a
    idéia/projeto dele?  Twisted Evil
    Se é tão bom assim...


    Ajude a ser ajudado:
    Seja objetivo na dúvida, dê os detalhes do que precisa, sem rodeios.
    Quando anexar teu projeto, diga onde está o problema, ganhamos mais tempo
    sem precisar procurar o mesmo.
    Thearles
    Thearles
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 36
    Registrado : 26/12/2011

    [Resolvido]Mover arquivos e salvar o diretório Destino Empty Re: [Resolvido]Mover arquivos e salvar o diretório Destino

    Mensagem  Thearles 13/1/2015, 21:48

    Boa noite,

    testei o código Noobezinho, e funcionou direitinho, muito obrigado! Peço, se não for abusar da sua boa vontade, que comente os comandos, pois a maioria não conheço. Considero o tópico resolvido. Uma última duvida: ao navegar pelos meus registros (no formulário) utilizando botões de comando, as caixas de texto, de listagem e tudo mais que há (exceto a imagem e as guias ou abas) demoram alguns segundos para aparecer, parece que pulam, sabe dizer o porquê disso, meu banco de dados tem apenas 9 MB! Valeu, muito obrigado!
    Noobezinho
    Noobezinho
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 4140
    Registrado : 29/06/2012

    [Resolvido]Mover arquivos e salvar o diretório Destino Empty Re: [Resolvido]Mover arquivos e salvar o diretório Destino

    Mensagem  Noobezinho 14/1/2015, 10:30

    O que te passei, é uma função de usuário, ou seja criado por um usuário, não é nativa do access.
    Ela recebe o caminho completo, por exemplo:
    C:\Users\Usuario\Desktop\Em uso2\Temporario\Foto.jpg
    e separa o nome do arquivo com o restante do caminho

    Se eu escrever SplitFile(Me.lstOpcao.Column(1),True) , retorna o nome do arquivo
    e se colocarmos no lugar do True, o False , ela retorna o caminho até chegar no nome do arquivo, ou seja:
    C:\Users\Usuario\Desktop\Em uso2\Temporario\

    Estude o código e use e abuse da Ajuda do Acess.
    Se não sabe ainda, na folha de código vba, clique sobre um comando e aperte F1 que a ajuda do comando irá aparecer.

    Como és novo no fórum, convido-o a colocar o Resolvido no título do tópico.
    Caso não saiba como, veja ali embaixo na minha assinatura.

    Boa sorte!

    Noob


    .................................................................................
    A pergunta que não quer calar:
    Por quê quando alguém vem pedir ajuda e conforme o caso pedimos
    para enviar parte do projeto, não temos mais continuidade do tópico?  
    Crê que temos bolas de cristal ou está com medo que "roubemos"  a
    idéia/projeto dele?  Twisted Evil
    Se é tão bom assim...


    Ajude a ser ajudado:
    Seja objetivo na dúvida, dê os detalhes do que precisa, sem rodeios.
    Quando anexar teu projeto, diga onde está o problema, ganhamos mais tempo
    sem precisar procurar o mesmo.
    Thearles
    Thearles
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 36
    Registrado : 26/12/2011

    [Resolvido]Mover arquivos e salvar o diretório Destino Empty Re: [Resolvido]Mover arquivos e salvar o diretório Destino

    Mensagem  Thearles 14/1/2015, 15:15

    Obrigado pela boa vontade em me ajudar, continuarei estudando VBA e Access, pretendo me aprofundar bastante! Abraços.

    Conteúdo patrocinado


    [Resolvido]Mover arquivos e salvar o diretório Destino Empty Re: [Resolvido]Mover arquivos e salvar o diretório Destino

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 28/3/2024, 12:30