[Resolvido]Inserir arquivo formato dwg e pdf mysql x access e fazer o download do arquivo

Bom dia a todos,

Estou com uma dúvida quanto a inserir/atualizar registros com arquivo de imagem no banco mysql formato blob.
Sei que não é o ideal devido ao tamanho do banco / performance, mas é uma exigência do cliente!

banco de dados = mysql
access = 2019
formato do campo imagem = blob

Tenho o seguinte código para inserir os registros:

Código:



    Call fnConn
    
    sSQL = "INSERT INTO pt02itens " _
    & "(pt02idfilial ,pt02idprojetos ,pt02tipodesenho, pt02arquivo , pt02nomearquivo ," _
    & "pt02datacad ,pt02dataaut , pt02idusuariocad )" _
    & "VALUES " _
    & "(" & TempVars!varidFilial & "  ,'" & pt01idprojetos & "' ,'" & pt02tipodesenho & "' ,'" & pt02arquivo & "' ,'" & pt02nomearquivo & "' , " _
    & "'" & Format(Date, "yyyy-mm-dd") & "' ,'" & Format(Now, "yyyy-mm-dd hh:mm:ss") & "' , " & TempVars!varidusuario & ")"

    cn.Execute sSQL
    cn.Close      



Lendo as mensagens do forum sobre assuntos relacionados, encontrei o seguinte para salvar arquivos:

Código:



Dim mstream As ADODB.Stream

Call fnConn

sSQL = ("SELECT * FROM pt02itens WHERE pt02iditens = " & pt02iditens & "")
rs.Open sSQL, cn, adOpenKeyset ', adLockReadOnly

If Len(strfName) > 0 Then
Set mstream = New ADODB.Stream
mstream.type = adTypeBinary
mstream.Open
mstream.LoadFromFile strfName
rs.Fields("pt02arquivo").Value = mstream.Read
rs.Update
End If


rs.Close
cn.Close




Quando tento incluir o registro recebo um erro em rs.Fields("pt02arquivo").Value = mstream.Read.

---------------------------
Erro
---------------------------
Erro: 3251 - O conjunto de registros atual não oferece suporte para atualização. Isso pode ser uma limitação do provedor ou do tipo de bloqueio selecionado.
---------------------------
OK  
---------------------------


Peço por favor ajuda dos mestres do forum de como adaptar os códigos e conseguir salvar o registro com o arquivo.


Para fazer o download do arquivo para uma pasta x ao clicar em um botão tenho esse código que consegui aqui no forum e que irei tentar usar quando a inclusão for bem sucedida.

Código:



Private Sub btDown_Click()
Dim intChoice As Integer
Dim strPath As String, strSQL As String
Dim strFilename As String
Dim strAttachN As String



'''''''Exporta o arquivo do banco de dados

    Call fnConn
    
    sSQL = ("SELECT * FROM pt02itens WHERE pt02iditens = " & pt02iditens & "")
    rs.Open sSQL, cn, adOpenKeyset, adLockReadOnly
 
   On Error Resume Next ' Aqui você pode tratar o erro, pois quando o campo da atbela aparece vazia, ocorre erro, porém, nesse caso, o Resume Next funciona perfeitamente.
   strFilename = rs.Fields("pt02nomearquivo")
   strAttachN = rs.Fields("pt02arquivo").Value
  
   If strAttachN = "" Then
       MsgBox "Documento não disponível para download!", vbInformation, "Aviso"
       Exit Sub
   Else
  
   ''''''Salvar como
  
       Application.FileDialog(msoFileDialogSaveAs).Title = "Salvar como"
      
       'nome inicial do ficheiro
       Application.FileDialog(msoFileDialogSaveAs).InitialFileName = strFilename
      
       'mostrar
       intChoice = Application.FileDialog(msoFileDialogSaveAs).Show
      
       'determinar escolha
       If intChoice <> 0 Then
        'obter o caminho do arquivo selecionado pelo usuário
        strPath = Application.FileDialog(msoFileDialogSaveAs).SelectedItems(1)
       End If
          
       On Error GoTo Fim

       Set mstream = New ADODB.Stream
       mstream.type = adTypeBinary
       mstream.Open
      
       mstream.Write rs.Fields("pt02arquivo").Value
       mstream.SaveToFile (strPath), adSaveCreateOverWrite
      
       rs.Close
       cn.Close
      
       If MsgBox("O download do arquivo foi realizado com sucesso!" & vbCrLf & strPath & vbCrLf & "Deseja abrir o arquivo?", vbQuestion + vbYesNo, "Aviso") = vbYes Then
           Shell "explorer.exe " & strPath, vbMaximizedFocus
       End If
          
   End If

  
Fim:

   If err.Number = 3001 Then
       MsgBox "Download cancelado!", vbInformation, "Aviso"
      
       rs.Close
       cn.Close
       Cancel = True
      
   End If
  
End Sub



Desde já agradeço a ajuda de todos.

Obrigado

Olá Giovanni Paiva

Veja se ajuda:

Código:

https://www.usandoaccess.com.br/tutoriais/configurar-access-com-mysql-parte-1.asp?id=1#inicio
https://www.maximoaccess.com/t29913-resolvidoarquivo-ole-blob-extrair-dados-criar-ficheiro
https://www.maximoaccess.com/t23419-resolvido-gravar-upload-arquivos-pdf-jpg-docx-xlsx-zip-em-uma-tabela-vinculada-ao-sql-server

Abraço

Boa tarde a todos!

Alvaro Teixeira, obrigado pelos links, estava tentando adaptar o meu projeto com a 3a. opção por você sugerida!

Não consegui fazer da forma que eu pretendia que era através do insert into, mas resolvi a situação fazendo o insert de parte do registro e depois faço o upload do arquivo.

Tive que ajustar o limite de upload no ini do mysql;
Usei o formato de dados do campo da imagem como MediumBlob;
Inclui na função salvar o nome do arquivo;


Os códigos ficaram assim:

Função para localizar o arquivo

Código:



Public Function fncLocalizarArquivo()
Dim fd As Office.FileDialog
On Error GoTo trataerro
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
   With .Filters
       .Clear
       .Add "PDF Files", "*.pdf", 1
       .Add "Image Files", "*.bmp, *.gif, *.jpg, *.png, *.tif", 2
       .Add "CAD Files", "*.dgn, *.dwg, *.dxf", 3
       .Add "Access DB", "*.mdb, *.accd*", 4
       .Add "MS Office", "*.doc*, *.xls*, *.ppt*", 5
       .Add "Zip Files", "*.zip, *.rar, *.7z", 6
       .Add "Todos", "*.*", 7

   End With
   .Title = "Selecionar o Documento!"
   .AllowMultiSelect = False
   .InitialFileName = "d:\"
   .InitialView = msoFileDialogViewPreview
   If .Show Then
       fncLocalizarArquivo = .SelectedItems(1)
   End If
End With
sair:
   Exit Function
trataerro:
   fnclocalizararquivopdf = ""
   Resume sair:
End Function



Função para salvar o registro e fazer o upload do arquivo:

Código:



On Error GoTo trata_erro

If Me.pt01idprojetos = 0 Then
   MsgBox "Salve o registro antes de incluir o projeto!"
   Exit Sub
End If

'Valida dados
    If IsNull(Trim(Me.pt02tipoprojeto)) Or Me.pt02tipoprojeto = "" Then
        MsgBox "Entre com o Tipo do Projeto para realizar as alterações...", vbInformation, "Aviso"
        Me.pt02tipoprojeto.SetFocus
        Exit Sub
    End If

    
If Me.pt02iditens = 0 Then

'aqui salvo os dados dos campos no banco de dados
Call fnConn
 
    sSQL = "INSERT INTO pt02itens " _
    & "(pt02idfilial ,pt02idprojetos ,pt02tipodesenho," _
    & "pt02datacad ,pt02dataaut , pt02idusuariocad )" _
    & "VALUES " _
    & "(" & TempVars!varidFilial & "  ,'" & pt01idprojetos & "' ,'" & pt02tipodesenho & "' , " _
    & "'" & Format(Date, "yyyy-mm-dd") & "' ,'" & Format(Now, "yyyy-mm-dd hh:mm:ss") & "' , " & TempVars!varidusuario & ")"
    
    cn.Execute sSQL
    
    'carrega o id do registro adicionado
    sSQL = ("SELECT last_insert_id()")
    rs.Open sSQL, cn, adOpenKeyset, adLockReadOnly
    
            Me.pt02iditens = rs("last_insert_id()")
            
    rs.Close         'Encerra a conexão com o recordeset
    Set rs = Nothing 'limpa o recordset da memória    
    
Else

' caso seja edição do registro
    Call fnConn

    sSQL = "UPDATE pt02itens SET" _
    & " pt02idfilial = '" & TempVars!varidFilial & "' ,  pt02idprojetos = '" & pt01idprojetos & "' ," _
    & " pt02tipodesenho = '" & pt02tipodesenho & "' , pt02arquivo = '" & pt02arquivo & "' ," _
    & " pt02idusuariocad = " & TempVars!varidusuario & " ," _
    & " pt02dataaut = '" & Format(Now, "yyyy-mm-dd hh:mm:ss") & "' " _
    & " WHERE pt02iditens = " & pt02iditens & ""
    
    cn.Execute sSQL

End If
    
' aqui salvo o arquivo e o nome do arquivo do resgistro no banco de dados
Dim mstream As ADODB.Stream

sSQL = ("SELECT * FROM pt02itens WHERE pt02iditens = " & pt02iditens & "")
rs.Open sSQL, cn, adOpenKeyset, adLockOptimistic

Dim Filepath As String: Filepath = fncLocalizarArquivo

Set mstream = New ADODB.Stream
mstream.type = adTypeBinary
mstream.Open
mstream.LoadFromFile (Filepath)
rs.Fields("pt02nomearquivo") = Dir(Filepath, vbArchive)
rs.Fields("pt02arquivo").Value = mstream.Read
rs.Update

rs.Close
Set rs = Nothing
cn.Close

Filepath = Empty

    Call LimpaItem
    
    Call AddTabItens ' salva registro na tabela temporaria local
    
    Me.ListaProjetos.Requery
    
    Me.pt02tipodesenho.SetFocus
    

MsgBox "Registro atualizado com sucesso.", vbInformation, "AltaSystem"

    Exit Sub

trata_erro:

   MsgBox "Erro: " & err.Number & " - " & err.Description & "", vbCritical, "Erro"
   If rs.State = 1 Then rs.Close: Set rs = Nothing
   If cn.State = 1 Then cn.Close



Código para fazer o Download do arquivo

Código:



Private Sub btDown_Click()
Dim intChoice As Integer
Dim strPath As String, strSQL As String
Dim strFilename As String
Dim strAttachN As String

If Me.pt02iditens = 0 Then
   MsgBox "Selecione um registro para fazer o download da imagem!"
   Exit Sub
End If


'''''''Exporta o arquivo do banco de dados

    Call fnConn
    
    sSQL = ("SELECT * FROM pt02itens WHERE pt02iditens = " & pt02iditens & "")
    rs.Open sSQL, cn, adOpenKeyset, adLockReadOnly
 
   On Error Resume Next ' Aqui você pode tratar o erro, pois quando o campo da atbela aparece vazia, ocorre erro, porém, nesse caso, o Resume Next funciona perfeitamente.
   strFilename = rs.Fields("pt02nomearquivo")
   strAttachN = rs.Fields("pt02arquivo").Value
  
   If strAttachN = "" Then
       MsgBox "Documento não disponível para download!", vbInformation, "Aviso"
       Exit Sub
   Else
  
   ''''''Salvar como
  
       Application.FileDialog(msoFileDialogSaveAs).Title = "Salvar como"
      
       'nome inicial do ficheiro
       Application.FileDialog(msoFileDialogSaveAs).InitialFileName = strFilename
      
       'mostrar
       intChoice = Application.FileDialog(msoFileDialogSaveAs).Show
      
       'determinar escolha
       If intChoice <> 0 Then
        'obter o caminho do arquivo selecionado pelo usuário
        strPath = Application.FileDialog(msoFileDialogSaveAs).SelectedItems(1)
       End If
          
       On Error GoTo Fim

       Set mstream = New ADODB.Stream
       mstream.type = adTypeBinary
       mstream.Open
      
       mstream.Write rs.Fields("pt02arquivo").Value
       mstream.SaveToFile (strPath), adSaveCreateOverWrite
      
       rs.Close
       cn.Close
      
       If MsgBox("O download do arquivo foi realizado com sucesso!" & vbCrLf & strPath & vbCrLf & "Deseja abrir o arquivo?", vbQuestion + vbYesNo, "AVISO") = vbYes Then
           Shell "explorer.exe " & strPath, vbMaximizedFocus
       End If
          
   End If

  
Fim:

   If err.Number = 3001 Then
       MsgBox "Download cancelado!", vbInformation, "AVISO"
      
       rs.Close
       cn.Close
       Cancel = True
      
   End If
  
End Sub



Mais uma vez muito obrigado pela ajuda, é muito bom fazer parte dessa comunidade !!

Olá Giovanni Paiva,

Fico feliz por ter conseguido resolver.
Obrigado pela partilha da sua solução, o fórum agradece.

Abraço