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
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
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
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:
Removi o select e estou gravando direto. escreveu:
crysostomo escreveu:estou tentando mudar o caminho do destino