[Resolvido]Salvar uma imagem (.bmp) na tabela via VBA

Olá pessoal,

Estou com dificuldade para criar um código em um botão para salvar uma imagem em um objeto OLE não acoplado. Tenho uma tabela (tblImagem) com dois campos: Codigo, Imagem. O campo Codigo é do tipo Numeração automática. A cada inserção iria para o registro seguinte. Pesquisei uma solução do Harrysohn, mas não consegui aplicá-la para o meu propósito. Se ele ler este tópico e puder me ajudar, ficaria agradecido. É claro, todos são bem-vindos e estarei imensamente grato.

Tentei de forma simples com este código:

Private Sub cmdLogo_Click()
On Error Resume Next
Dim sImagem As String
Dim strSQL As String


sImagem = Forms!Catálogo!cxImagem  'cxImagem é o objeto OLE Não acoplado
strSQL = "INSERT INTO tblImagem(Imagem) VALUES('" & sImagem & "')"
CurrentDb.Execute strSQL

End Sub

Por que declarei a variável sImagem como do tipo String?

Porque funcionou perfeitamente a despeito de ser do tipo Variant neste código, o qual este último(tipo de dados) não funcionou:

Private Sub cmdBorda_Click()
On Error Resume Next
Dim sImagem2 As String
Dim strSQL2 As String
Dim n As Integer


n = DLookup("ID", "tblBordas", "ID = Forms!Catálogo!cboBordasCol")

sImagem2 = DLookup("Bordas", "tblBordas", "ID = " & n)

Me.cxImagem = sImagem2   'Neste objeto OLE Não acoplado consigo visualizar a imagem pesquisada na tabela tblBordas.
Me.cxImagem.Width = 4 * 567
Me.cxImagem.Height = 2.5 * 567

End Sub

Não sei se ajuda mas..

http://support.microsoft.com/kb/205635/pt-br

Bom dia a todos...

Não sei se vai lhe ajudar Good, mas eu uso essa rotina para incluir fotos...

Código:

Private Sub bt_adcfoto_Click()
 Dim strCaminho As String, strPastaInicial As String
 
    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
   
   
        Me.localfoto = Mid([strCaminho], InStrRev([strCaminho], "\") + 1)
       
      Me.foto.Picture = CurrentProject.Path & "\funcionario\" & Me.localfoto.Value
    End If

Na tabela tenho um campo "Localfoto "no formato de texto onde armazeno o local da mesma.
No formulário, um quadro de imagem, com o nome de "foto".
Eu não costumo armazenar imagens dentro do projeto ou do banco para não sobrecarregar o mesmo com o passar do tempo, jogo as imagens em uma pasta, aqui chamada "funcionário" e deixo essa pasta junto com o banco.

Obrigado amigos Formiga e Silvio,

Vou tentar uma solução de cada vez. Primeiro vou considerar a do Silvio que está mais prático para copiar, colar e ajustar.
Vamos tirar algumas dúvidas, Silvio:


localfoto - ? Seria meu campo Imagem que é do tipo OBJETO OLE?


Minha fonte de dados em um arquivo dentro da pasta onde está o bd. Como pode ser o campo Imagem do tipo Texto?. Aqui não entendi.

tblImagem - Tabela com as fotos ou logos .bmp
Campos - ID(Numeração Automática), Imagem (Objeto OLE)

Boa tarde, good guy
Veja http://support.microsoft.com/kb/205635/pt-br

Olá Alexandre,

Esta solução o Formiga já apresentou. O problema que o código serve apenas para o VB6, o que não é o meu caso.

Good, me passa teu mail, que vou te passar um que já esta rodando com todas as aplicações.
No aguardo de tua resposta.

Silvio

Olá Silvio,

Você tem dropbox? Se for tão pesado assim, posta o link que eu baixo aqui. Tem as regras do fórum. Não podemos esquecê-las, grande amigo.

Sim eu sei das regras, mas o problema é que está feito e rodando em cliente.
Não é pesado não...

Boa noite, tente assim:

   With Me.CampoNoFormulário
       .Class = "Paint.Picture"
       .OLETypeAllowed = acOLEEmbedded
       .SourceDoc = Caminho do BMP
       .Action = acOLECreateEmbed
   End With
   DoCmd.RunCommand acCmdSaveRecord
   Me.Repaint

tem um aqui, que eu desenvolvi a muito tempo atrás.

Grande Jungli, não vi que estavas a responder também....desculpe !

 , mais informação = mais crescemos

Olá Silvio,

Tentei seu exemplo, mas acusou a seguinte mensagem:

O Microsoft Access não pode abrir o arquivo
'C:\ProjetoCadastro\funcionario\1 - angelina.bmp'.  '(ou angelina.jpg original)


Já no seu exemplo, Jungli acusou:

Erro de compilação:
Uso inválido de propriedade

With Me
   .cxImagem    <=========
   .Class = "Paint.Picture"
   .OLETypeAllowed = acOLEEmbedded
   .SourceDoc = "F:\MeusAplicativos\Logos\EngenhariaCivil3.bmp"
   .Action = acOLECreateEmbed
  End With
  DoCmd.RunCommand acCmdSaveRecord
  Me.Repaint

Estou postando o arquivo para os senhores analisarem:

Olá good guy
Realmente, não me apercebi que estava a repetir a resposta
Estou a tentar adaptar daqui (http://support.microsoft.com/default.aspx?scid=KB;en-us;q103257) mas ainda não consegui e não tenho tempo para continuar hoje a tentar

Bom dia a todos, saúde e paz !

Good, eu acho que seria mais ou menos isso.

Bom dia,

vejamos se assim dá certo,

Olá amigos,

Gostei das duas soluções. Vou ter que fazer alguns testes para saber qual é a melhor solução no meu projeto. Estão de parabéns tanto o Silvio quanto o Jungli. Diante dos códigos apresentados vejo o quanto tenho que aprender ainda. Obrigado !!!

Olá Jungli,

Ao testar sua solução, verifiquei que ao colar uma figura (.bmp) e depois de inseri-la, quando volto a visualizá-la não é a mesma, mas uma figura padrão de sem imagem (X). Pode verificar?

Boas Mestre God,

Atualize a sua cópia do db por favor.

Código:

Private Sub cmdLogo_Click()
    'On Error Resume Next
    Dim sImagem As String
    Dim strSQL As String
    '// Pega o nome do arquivo
        strCaminho = CurrentProject.Path & "\1050.bmp"
    '// Abre a imagem no formulário e popula na tabela
    If IsNull(Me.cxImagem.Value) Then
            If Len(strCaminho) > 0 Then
                Me.cxImagem.Class = "Paint.Picture"
                Me.cxImagem.OLETypeAllowed = acOLEEmbedded
                Me.cxImagem.SourceDoc = Trim(strCaminho)
                Me.cxImagem.Action = acOLECreateEmbed
                '// Cria o recordset
                    Dim rst As DAO.Recordset
                    Set rst = CurrentDb.OpenRecordset("tblImagem")
                '// Atualiza o formulário
                    Me.Recalc
                '// Popula o recordset
                    rst.AddNew
                    rst.Fields("Imagem").Value = Me.cxImagem.Value
                    rst.Update
                '// Fecha o recordset e limpa a memória
                    Set rst = Nothing: Close
            End If
    Else
                Me.cxImagem.Class = "Paint.Picture"
                Me.cxImagem.OLETypeAllowed = acOLEEmbedded
                '// Abre o recordset
                    Set rst = CurrentDb.OpenRecordset("tblImagem")
                '// Atualiza o formulário
                    Me.Recalc
                '// Popula o recordset
                    rst.AddNew
                    rst.Fields("Imagem").Value = Me.cxImagem.Value
                    rst.Update
                '// Fecha o recordset e limpa a memória
                    Set rst = Nothing: Close
    End If
End Sub

OK Jungli,

Agora funfou.

Obrigadão !!!

P.S.: Por favor, altere meu nome de God(Deus) para Good (Legal). Deus só há um. É Ele, o Criador, que nos capacita a todos nós.

Ok Goog guy...