MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

2 participantes

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

    avatar
    gtpsp
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 38
    Registrado : 01/11/2013

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

    Mensagem  gtpsp Sex 11 Nov 2022, 12:39

    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
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7714
    Registrado : 15/03/2013

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

    Mensagem  Alvaro Teixeira Sex 11 Nov 2022, 15:55

    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

    gtpsp gosta desta mensagem

    avatar
    gtpsp
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 38
    Registrado : 01/11/2013

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

    Mensagem  gtpsp Qua 16 Nov 2022, 19:38

    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 !!
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7714
    Registrado : 15/03/2013

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

    Mensagem  Alvaro Teixeira Qui 17 Nov 2022, 00:37

    Olá Giovanni Paiva,

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

    Abraço

      Data/hora atual: Qui 26 Jan 2023, 21:15