São estes dois códigos que possuo

On Error GoTo PROC_ERR

'verifica se o nome do cliente foi digitado
If Len(Me.Nome_Func & "") = 0 Then
MsgBox "Falta o nome do Funcionário, campo obrigatório.", vbInformation, ""
Me.Nome_Func.SetFocus
Exit Sub
End If

' Requer referencia a Microsoft Office 11 Object Library
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)

fd.Title = "selecione o arquivo da imagem"
fd.Filters.Add "Arquivos de imagem", "*.bmp; *.png; *.jpg", 1

fd.Show

If (fd.SelectedItems.Count > 0) Then
Dim strPathFileOrigem, strImagens As String

   'arquivo escolhido
   strPathFileOrigem = fd.SelectedItems(1)
   
   'caminho destino e nome arquivo para copia de arquivo das imagens
   strImagens = Application.CurrentProject.Path & "\Fotos\" & Me.Id & "_" & Me.Nome_Func & Right(strPathFileOrigem, 4)
 
   'copiar
   FileCopy strPathFileOrigem, strImagens
   MsgBox "Arquivo arquivado em: " & vbCrLf & vbCrLf & strImagens, vbInformation, "Operação concluída."

   'actualiza dados form
   Me.txtCaminho = Mid(strImagens, InStrRev(strImagens, "\") + 1)
   Me.imagemCliente.Picture = Application.CurrentProject.Path & "\Fotos\" & Me.txtCaminho
   DoCmd.Save

Else

   MsgBox "Não foi escolhido nenhum Arquivo", vbInformation, ""

End If

PROC_EXIT:
Exit Sub

PROC_ERR:
DoCmd.Hourglass False
MsgBox Err.Number & " - " & Err.Description
Resume PROC_EXIT

Private Sub Form_Current ()
If Right (Application.CurrentProject.Path & “\Fotos\” & Me.TxtCaminho, 1) = “\” Then
Me.ImagemCliente.Picture = Application.CurrentProject.Path & “\Fotos\” & “NaoExiste.bmp”
Else
Me.ImagemCliente.Picture = Application.CurrentProject.Path & “\Fotos\” & Me.TxtCaminho
End If

0 answers