[Resolvido]Colocar arquivo na pasta do sistema

Meus amigos boa tarde.
tenho um sistema aqui que anexa os arquivos , mas queria que copie o documento para dentro dele.
naveguei no fórum emas não consegui ajustar .
poderia me ajudar

Boa tarde,
para dentro de quê?

Bom dia Marcelo
Estou com um sistema que arquiva o documento
Ex, arquivo um arquivo que está em documento/pdf

Meu sistema está no C/SistemaArquivamento
Quero que o arquivo pego na pasta de documentos/pdf cópie o documento para dentro do meu sistema ( C/SistemaArquivamento/ Arquivos)

Nesse caso, para apontar a pasta onde o aplicativo está rodando,
use:
CurrentProject.Patch

Esse comando, retorna o local de execução do sistema.

Por exemplo, se seu sistema está em C:\SistemaArquivamento\SeuSistema.accdb e quer copiar arquivos para pasta Arquivos que está
dentro da pasta onde o sistema está, você deve por no destido da cópia assim:

CurrentProject.Patch & "\Arquivos"

Pois a linha de cima é o mesmo que isso:

C:\SistemaArquivamento\Arquivos

Boa tarde Marcelo ,não está aceitando o método antes dele linkar o arquivo tem que ser copiado dentro da pasta.
vou tentando aqui , e depois te passo se não conseguir.

Código:

Private Sub Comando57_Click()
On Error GoTo x1
Dim c1, Arquivos
If IsNull(Me.nome) Then
MsgBox ("Preencha o Registro")
Exit Sub
End If
With Application.FileDialog(msoFileDialogFilePicker)
Dim lin As String
.AllowMultiSelect = False

.Title = "Selecione o Arquivo"

.Filters.Clear
'.Filters.Add "jpg", "*.jpg"
'.Filters.Add "bmp", "*.bmp"
'.Filters.Add "gif", "*.gif"
'.Filters.Add "png", "*.png"
.Filters.Add "Todos os arquivos", "*.*"
If .Show = True Then
lin = .SelectedItems(1)
'MsgBox lin
Dim ds, x
x = Me.cod
ds = InputBox("Entre Com A Descrição: ")
Arquivos=CurrentProject.Patch & "\Arquivos"
CurrentDb.Execute "INSERT INTO link1 (link, numreg, nome1 ) " & _
"SELECT '" & lin & "' AS l, '" & x & "' AS num, '" & ds & "' AS n"
Me.Lista0.Requery
End If
End With


Exit Sub
x1: MsgBox Err.Description

End Sub

não entendi o porque não está movendo?

Boa noite meu amigo,
Você não escreveu o códio para fazer cópia de arquivos. Apenas etá salvando o caminho.

Observe que o terá que gravar ao invés da origem, o destino pois o arquivo será copiado para o diretório
onde está seu aplicativo.

Bom dia!

Eu utilizo a rotina abaixo para selecionar o arquivo e copiar para a pasta já renomeando.

Crédito ao ToPBr

Código:

Private Sub inserir_ft1_mld_Click()

'By ToPBr 2010
'Adicionar foto a registro e copiar arquivo de foto para pasta do bd

  
If IsNull(Me.foto1_molde) = False Then
   If MsgBox("Já existe uma foto, deseja apagar e adicionar outra?", vbYesNo, "Aviso de Inclusão") = vbNo Then
      DoCmd.CancelEvent
   Exit Sub
   Else
   Me.foto1_molde = Null
   End If
End If
      
   If IsNull(Me.NomeCliente) = True Then
   MsgBox "Para capturar a foto é necessário informar o nome do cliente", vbInformation, "Aviso"
   DoCmd.CancelEvent
   Me.img_ft1_molde.SetFocus
   Exit Sub
   End If

  
   Dim strCaminho As String, strPastaInicial As String
   Dim CopiaSegura As Object
   Dim caminho As String
   Dim fso As Object
   Dim cam As String
   Dim strCaminnhoPasta As String
   Dim Pasta As String
   Dim numcrtl As String
   Dim nummld As String
   Dim nmclt As String
  
  
    
    numcrtl = Form_Documento_Controlo.Num_Doc_Controlo.Value
    nummld = Form_Documento_Controlo.NumeroMolde.Value
    nmclt = Form_Documento_Controlo.NomeCliente.Value
    
    
    
    Pasta = "\\2425FS01\Jobs\DB_Sis_Fabrico_em_teste\" & numcrtl & "-" & nummld & "-" & nmclt & "\Entrada_Saida" 'local onde quer salvar a foto
        
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(Pasta) Then ' verifica se já existe a pasta
    Else
    MkDir Pasta ' se não existir cria
    End If
    
    strCaminnhoPasta = Pasta & "\"
    
    strPastaInicial = "C:\Meus Documentos"
    strCaminho = Buscar(Me.hwnd, "Inserir foto", strPastaInicial, _
    "Arquivos gráficos (*.bmp; *.gif; *.jpg)" & vbNullChar & "*.bmp; *.gif; *.jpg")
    If Len(strCaminho) > 0 Then
      
    cam = strCaminnhoPasta & "\" ' Caminho do bd mais a pasta fotos
  
      
  ' Faz a cópia do arquivo para a pasta do bd e sub pasta Fotos renomeando para jpg
    Set CopiaSegura = CreateObject("Scripting.FileSystemObject")
    CopiaSegura.CopyFile strCaminho, cam & numcrtl & "_" & nummld & "_" & 1 & ".jpg"
  
    Me.foto1_molde = cam & numcrtl & "_" & nummld & "_" & 1 & ".jpg"
    Me.img_ft1_molde.Picture = Me.foto1_molde
    
    
    End If

DoCmd.RefreshRecord



End Sub


Não compreendi, pois mesmo fazendo pelo fso ou filecopy não consigo fazer a cópia.

Código:

On Error GoTo x1
Dim c1
If IsNull(Me.nome) Then
MsgBox ("Preencha o Registro")
Exit Sub
End If
With Application.FileDialog(msoFileDialogFilePicker)
Dim lin As String
buscaArquivo = "" ' Define source file name.
destinoDoArquivo = "B:\CÓPIAS DE SISTEMAS\sistemas em andamento\Sistemas concluidos\Arquivamento\Nova pasta" ' Define target file name.
FileCopy buscaArquivo, destinoDoArquivo '

.AllowMultiSelect = False
.TITLE = "Selecione o Arquivo"

.Filters.Clear
'.Filters.Add "jpg", "*.jpg"
'.Filters.Add "bmp", "*.bmp"
'.Filters.Add "gif", "*.gif"
'.Filters.Add "png", "*.png"
.Filters.Add "Todos os arquivos", "*.*"


If .Show = True Then
lin = .SelectedItems(1)
'MsgBox lin
Dim ds, x
x = Me.cod
ds = InputBox("Entre Com A Descrição: ")


CurrentDb.Execute "INSERT INTO link1 (link, numreg, nome1 ) " & _
"SELECT '" & lin & "' AS l, '" & x & "' AS num, '" & ds & "' AS n"
Me.Lista0.Requery
End If
End With


Exit Sub
x1: MsgBox Err.Description

End Sub

Private Sub Comando59_Click()
On Error GoTo f
If IsNull(Me.Lista0) Or IsEmpty(Me.Lista0) Then
Exit Sub
End If
Dim x
x = MsgBox("Deseja Excluir Este Arquivo Selecionado?   Obs:  Você Não Está Excluindo o Arquiivo no HD e Sim o Link Para o Arquivo!", 1)
If x <> 1 Then
Exit Sub
End If
CurrentDb.Execute "Delete * From link1 where link1.n=" & Me.Lista0.Column(2)
Me.Lista0 = Null
Me.Lista0.Requery
f:

e nem assim
Call copiarArquivo("CurrentProject.Patch & "", "B:\CurrentProject.Patch & "\Arquivos", False)

Bom dia,
esqueci de anexar na minha mensagem anterior o exemplo.

Mais observações:
Vi que para gravar o link na tabela, vc faz uma select na outra. Não entendi o porque disso. Removi o select e estou gravando direto.

E para copiar, precisamos pegar o nome do arquivo no destino. Para isso estou usando o exemplo de código que criei e disponibilizei nesse link: https://www.maximoaccess.com/t36124-funcao-para-retornar-apenas-o-nome-do-arquivo-de-um-caminho

Veja se é o que pretende.

Removi o select e estou gravando direto. escreveu:

Cade Marcelo o anexo, vou ver essa link direto que você vez e estudar como ele é feito,
já o meu link 1 é ele fazer abrir o arqui direto aonde ele esta, mas pelo jeito que você fez ele copiar o arquivo e abrir por la mesmo. será ótimo

sem sucesso

Fiz um exemplo aqui. Veja se ajuda.

Se der erro, vai em referências e marca Microsoft Scripting Runtime

renpv, boa noite , interessante seu exemplo, mas esse objetivo é que ao anexar o arquivo, antes dele colocar o link para abrir os arquivos anexado ,ele já copiasse para a pasta do sistema, ou seja ele ja colocasse o link com
dê uma olhada no anexo acima.

Rapaz, não sei pq meu anexo não foi anexado... Outra tentativa...

Veja se atende.

Marcelo , Boa tarde , a noite verei o anexo, (pois estou na loja e pelo celular) para fechar esse sistema que estou com para entregar 6 feira .
Ainda tenho pouco conhecimento em grandes partes. Qlquaqier coisa te retorno, já te agradecendo pela atenção

Bom dia Marcelo, estou tentando mudar o caminho do destino ,mas está dando numero de posição incorreta
e o link do arquivo não está sendo executado

crysostomo escreveu:estou tentando mudar o caminho do destino

Não entendi, poderia detalhar melhor?

No aguardo.

deste ja obrigado pela atenção , nessa minha correria .
o sistema vai ficar na pasta C:\SistArquivamento e dentro dessa pasta tem a pasta aonde que pretendo colocar os arquivos, ou seja
C:\SistArquivamento\Arquivos
o seu anexo , ele coloca os arquivos para área de trabalho,  e os arquivos na lista perderam o link de abrir eles porque sua posição grava os dois caminhos juntos.

Se eu entendi:
Os arquivos devem ir para dentro da pasta Arquivos que está na mesma pasta da aplicação. Se é isso, altere a linha abaixo do botão Arquivo
Destino = CurrentProject.Path & "\" & fncNomeArquivo(lin)

para

Destino = CurrentProject.Path & "\Arquivos\" & fncNomeArquivo(lin)

Boa tarde Marcelo, ja tinha alterado o caminho, estava dando com posição invalida tinha hora que dava caminho não localizado, ao chegar , te retorno.

Boa noite Marcelo, me desculpa a enrolação.
verifiquei aqui e o problema era uma barra "/" inversa,  agora vou verificar se todas as funções do sistema seguem de acordo, qualquer coisa te pesso ajuda por aqui mesmo, pode ser?
Já agradeço a sua atenção, e coloco esse tópico como resolvido.

Maravilha. Se problema relacionado a outra assunto, outro tópico.

Mas se está dando certo, ótimo.