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]Copiar arquivos via Access e renomear

    Compartilhe

    MMS
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 87
    Registrado : 12/04/2011

    [Resolvido]Copiar arquivos via Access e renomear

    Mensagem  MMS em Sab 25 Nov 2017, 22:46

    Peguei alguns exemplos aqui no Fórum de como copiar, mover arquivos de uma pasta para outra via Access e adaptei para minha necessidade. Está quase tudo perfeito, ocorre que preciso copiar um arquivo da pasta de origem e depois renomea-lo na pasta de Destino, Exemplo tem um arquivo FotoLoja.Jpg (origem) e preciso Renomear para FotoLoja_1.Jpg (Destino).

    Alguém sabe como posso fazer isso? abaixo segue o código como está hoje funcionando, porém sem renomear, apenas copiando.


    On Error GoTo MostraErro

    Dim fso, Item
    Dim strOrigem As String, strDestino As String

    If ListaFicheiros.ItemsSelected.Count = 0 Then
    MsgBox "Não tem nenhum arquivo selecionado.", 64, "Marcelo"

    Exit Sub
    End If
    strOrigem = Me.TopDir
    LePasta: strDestino = "T:\ANEXOS\"
    If strDestino = "" Then
    If MsgBox("Deve escolher uma pasta válida, ou cancelar a operação.", vbOKCancel) = vbYes Then
    GoTo LePasta
    Else
    Exit Sub
    End If
    End If
    Set fso = CreateObject("Scripting.FileSystemObject")
    'Se é invalida a pasta de Origem ou Destino
    If Not fso.FolderExists(strOrigem) Then
    MsgBox strOrigem & " Caminho invalido para a pasta de origem.", vbInformation, "Erro"
    ElseIf Not fso.FolderExists(strDestino) Then
    MsgBox strDestino & " Caminho invalido para a pasta de destino", vbInformation, "Erro"
    'Se não há arquivos a serem movidos
    Else
    If Right(strDestino, 1) <> "\" Then strDestino = strDestino & "\"
    For Each Item In ListaFicheiros.ItemsSelected

    'Se quiser copiar
    fso.CopyFile (strOrigem & "\" & ListaFicheiros.Column(0, Item)), strDestino
    Next

    Call Atualise
     
    ListaFicheiros.RowSource = ""


    DoCmd.Close A_FORM, "Selecionar_Arquivos"

    MsgBox strOrigem & " ARQUIVOS TRANSFERIDOS COM SUCESSO.", vbInformation, "Concluído"

    End If
    Exit Sub
    MostraErro:
    MsgBox Err.Number & vbCr & Err.Description
    avatar
    Avelino Sampaio
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3430
    Registrado : 04/04/2010

    Re: [Resolvido]Copiar arquivos via Access e renomear

    Mensagem  Avelino Sampaio em Dom 26 Nov 2017, 08:03

    MMS,

    para renomear, utilize o comando NAME AS do Access. Veja como, neste tópico abaixo:

    nota: copie e cole o endereço no seu navegador.

    redeaccess.com.br/viewtopic.php?f=17&t=1837&p=8059&hilit=Name#p8059

    Sucesso!

    MMS
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 87
    Registrado : 12/04/2011

    Copiar arquivos via Access e renomear

    Mensagem  MMS em Seg 27 Nov 2017, 16:55

    Avelino boa tarde!

    Muito obrigado, acrescentei no código a linha em vermelho com sua dica , conforme abaixo e funcionou perfeito! Não sei se tinha como fazer melhor na mesma linha, mas assim como está funcionou.

    'Se quiser copiar
    fso.CopyFile (strOrigem & "\" & ListaFicheiros.Column(0, Item)), strDestino
    Name (strDestino & "\" & ListaFicheiros.Column(0, Item)) As (strDestino & "\" & "MeuId" & "-" & ListaFicheiros.Column(0, Item))

    Next


      Data/hora atual: Seg 11 Dez 2017, 22:59