[Resolvido] Gravar (Upload) arquivos .pdf, .jpg, .docx, .xlsx, .zip em uma tabela vinculada ao SQL server

Bom dia,
estou trabalhando em um controle de documentos, e gostaria de salvar os arquivos dentro da tabela do SQL Server que é vinculada com o meu frontend (fazer uma upload diretamente para um campo da tabela, para futuramente fazer downloads).
Meu frontend é em Access e a Base de dados (Backend) é SQL server.

Fiz diversos tipos de busca no Fórum, mas somente encontrei funções que gravam o caminho do arquivo, e não é isso que eu preciso.


Desde já agradeço e fico no aguardo de colaborações dos nobres amigos do Fórum.

Att.,
Diego

Bom dia,
Veja se lhe ajuda support.office.com/en-sg/article/Attach-files-and-graphics-to-the-records-in-your-database-d40a09ad-a753-4a14-9161-7f15baad6dbd

Boa tarde Alexandre,
nesse exemplo que você indicou, não encontrei nenhuma correlação do Access com o SQL Server, não sei qual o TIPO DE CAMPO DA TABELA DO SQL SERVER usar, para que o Access 2010 reconheça como um campo para anexar arquivos.

Estou pesquisando outras fontes, mas nada de concreto ainda.

Preciso saber qual TIPO DE CAMPO DA TABELA NO SQL SERVER usar e que seja reconhecido pelo Access, depois eu posso até testar esse exemplo.

Obrigado e enviarei informações assim que obtiver algum avanço, creio que servirá par muitos aqui no Fórum.

Obrigado.

Diego

Olá a todos!
Diego Jacob, não tenho a certeza, mas acho que é tipo BLOB.
Já tenho visto alguns artigos sobre conversão para se fazer FILESTREAM.

Veja se links abaixo ajuda:
access-programmers.co.uk/forums/showthread.php?t=249350
social.msdn.microsoft.com/Forums/office/en-US/a34ffa28-6652-46a9-ade7-997349122082/document-storage-for-access-frontend-with-sql-server-backend?forum=accessdev
stackoverflow.com/questions/3749885/access-2007-to-sql-server-file-upload
experts-exchange.com/Database/MS_Access/Q_26923910.html
windowssecrets.com/forums/showthread.php/141654-MS-Access-2010-Adding-Attachments-from-Form-using-Unbound-Field-and-VBA
sqlservercentral.com/Forums/Topic1488918-131-1.aspx
Abraço

Boa tarde Alvaro, obrigado pela ajuda.
com os links enviados, eu consegui criar a tabela FileStream, a qual estava ocorrendo erro.

Agora, no exemplo:
experts-exchange.com/Database/MS_Access/Q_26923910.html
eu não consegui interpretar como usar as funções para ver se funciona. Podem colaborar com suas experiências?



Tabela criada no SQL Server:
     tbl_Attach_File

CAMPOS:

     ID_Attach_File
     ID_Document '(Para vícnculo do arquivo com o documento)
     Attach_Native_File '(Arquivo nativo, .docx, .xlsx, .zip etc.)
     Attach_PDF_File '(.pdf)
     Description_File '(Descrição do arquivo)


Função do exemplo:

Código:

Option Compare Database
Option Explicit

'Adiciona o arquivo
Sub AddFile(strDescription As String, strFilename As String)
   Dim con As New ADODB.Connection
   Dim rs As New ADODB.Recordset
   Dim objStream As New ADODB.Stream
   
   'create the stream
   objStream.Type = adTypeBinary
   objStream.Open
   objStream.LoadFromFile strFilename
   
   con.Open "PROVIDER=SQLOLEDB.1;PERSIST SECURITY INFO=FALSE;INITIAL CATALOG=FS;DATA SOURCE=(local)\sqlexpress2008r2;INTEGRATED SECURITY=SSPI"
   rs.Open "Select * from FSTest", con, adOpenDynamic, adLockOptimistic
   rs.AddNew
   rs!Description = strDescription
   rs!FS = objStream.Read
   rs.Update
   rs.Close
   objStream.Close
   con.Close
End Sub


'Visualiza o arquivo
Sub ReadFile(strDescription As String, strFilename As String)
   Dim con As New ADODB.Connection
   Dim rs As New ADODB.Recordset
   Dim objStream As New ADODB.Stream
   
   'create the stream
   objStream.Type = adTypeBinary
   objStream.Open
   
   con.Open "PROVIDER=SQLOLEDB.1;PERSIST SECURITY INFO=FALSE;INITIAL CATALOG=FS;DATA SOURCE=(local)\sqlexpress2008r2;INTEGRATED SECURITY=SSPI"
   rs.Open "Select * from FSTest where Description = '" & strDescription & "'", con, adOpenDynamic, adLockOptimistic
   If Not rs.EOF Then
       objStream.Write rs!FS
       objStream.SaveToFile strFilename, adSaveCreateOverWrite
       objStream.Close
   End If
   rs.Close
   con.Close
End Sub

Olá, "não sei se estou a dizer o maior disparate", mas a ideia dos artigos que vi parece que funciona da seguinte forma.

O campo tipo BLOB permite guardar no formato binário.
Parece que é necessário efectuar uma leitura no modo binário e guardar.
Adicionalmente no mesmo registo devemos ter o nome do ficheiro e tipo (extensão).
Quando desejamos um ficheiro arquivado na base de dados, a aplicação deverá fazer o inverso, que será ler no modo binário, criar novamente o ficheiro, numa pasta especifica ou temporária e por fim é que poderá ser aberto pelo respectivo aplicativo.
Desta forma até podemos guardar, executaveis, videos, etc.

Espero que ajude, entretanto mais dois links:
tek-tips.com/viewthread.cfm?qid=1549338
msdn.microsoft.com/en-us/library/windows/desktop/ms675032(v=vs.85).aspx

Este acho que vai resolver:
support.microsoft.com/pt-pt/kb/258038

Ficando aguardar se algum colega aqui do fórum tem mais alguma opinião.

Abraço

Muito obrigado Alvaro,
consegui fazer o upload do arquivo, usei um dos códigos informado:

Código:

Option Compare Database

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim mstream As ADODB.Stream


Private Sub Button_Native_File_Click()

Dim Filepath As String: Filepath = fncLocalizarArquivo


Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
rs.Open "Select * from ENG_tbl_Attach_File", cn, adOpenKeyset, adLockOptimistic

Set mstream = New ADODB.Stream
mstream.Type = adTypeBinary
mstream.Open
mstream.LoadFromFile (Filepath)
rs.Fields("Attach_Native_File").Value = mstream.Read
rs.Fields("Upload_Date_Native").Value = Now()
rs.Update

rs.Close
cn.Close

End Sub

Eu agreguei uma função que encontrei no Fórum, fncLocalizarArquivo, a qual abre uma janela para que eu possa selecionar o arquivo desejado.

Agora estou precisando de uma outra contribuição, que é para fazer o download, salvar o arquivo em um determinado local, igual ao "Salvar como" da maioria dos softwares, a função abaixo funciona, mas preciso informar um local fixo e o nome do arquivo.

Código:

Private Sub Button_Download_File_Click()

Dim strFilename As String
strFilename = "C:\BKP\teste_2.pdf" ' Aqui eu gostaria de incluir uma funcão "Salvar como", a qual eu pudesse selecionar um determinado diretório e o nome do arquivo por padrão, fosse o próprio nome do arquivo
strDescription = "Teste_2"

Set cn = CurrentProject.Connection

Set rs = New ADODB.Recordset
rs.Open "SELECT * FROM ENG_tbl_Attach_File where Description_File = '" & strDescription & "'", cn, adOpenKeyset, adLockOptimistic


Set mstream = New ADODB.Stream
mstream.Type = adTypeBinary
mstream.Open
mstream.Write rs.Fields("Attach_Native_File").Value
mstream.SaveToFile (strFilename), adSaveCreateOverWrite

rs.Close
cn.Close
       
End Sub


Estarei pesquisando como eu posso agregar a função "Salvar como" no código acima e enviarei a solução final ao Fórum, para que todos possam usar como exemplo.

Olá, sou da opinião que deveria gravar na base de dados , caso não pretenda o caminho e nome do ficheiro, que pelo menos grave o nome do ficheiro (com extenão)
Assim ficava com o registo da origem.
Ao repor o ficheiro, poderia atribuir o nome original
Quanto à questão  com o FileDialog resolve, veja links abaixo:
software-solutions-online.com/2014/03/13/vba-save-file-dialog-filedialogmsofiledialogsaveas/
msdn.microsoft.com/en-us/library/office/aa195878(v=office.11).aspx

Abraço

Muito legal a sua indicação.
Busquei no fórum alguns exemplos de separação do nome do arquivo, mas optei em separar apenas a extensão e concatenar no final do número do documento, incluindo-os em um campo "Description_file" como sugerido.

Quanto ao FileDialog está funcionando perfeitamente, porém, haveria alguma forma de já sugerir o NOME do arquivo gravado no campo description_file (NO EXEMPLO "Teste_2.pdf")?
Logo, sequencia ficaria: Selecionar o diretório desejado para salvar o arquivo, porém o NOME do arquivo já estaria por padrão na janela salvar como (Vindo do campo description_file), pois no código atual, o NOME do arquivo aparece em branco.

O código para salvar o arquivo ficou um pouco extenso, pois juntei as duas funções.

Código:

Private Sub Button_Save_File_Click()

'''Salvar como

Dim intChoice As Integer
Dim strPath As String

'change the display name of the save file dialog
Application.FileDialog(msoFileDialogSaveAs).Title = _
   "Salvar como"

'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogSaveAs).Show
'determine what choice the user made
If intChoice <> 0 Then
   'get the file path selected by the user
   strPath = _
       Application.FileDialog(msoFileDialogSaveAs).SelectedItems(1)
   'displays the result in a message box
End If

'-----------------------------------------------------------------------------


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

Dim strFilename As String
'strFilename = SalvarComo '"C:\BKP\teste_2.pdf"
strDescription = "Teste_2.pdf"

Set cn = CurrentProject.Connection

Set rs = New ADODB.Recordset
rs.Open "SELECT * FROM ENG_tbl_Attach_File where Description_File = '" & strDescription & "'", cn, adOpenKeyset, adLockOptimistic

On Error Resume Next

Set mstream = New ADODB.Stream
mstream.Type = adTypeBinary
mstream.Open
mstream.Write rs.Fields("Attach_Native_File").Value
mstream.SaveToFile strPath, adSaveCreateOverWrite

rs.Close
cn.Close


End Sub

Acabei de ver que o exemplo de separar a extensão do arquivo foi sua... rs

Olá, segue pretendido:

Código:

Sub testeSalvarComo()

    Dim intChoice As Integer
    Dim strPath As String
   
    'nome da caixa de diálogo
    Application.FileDialog(msoFileDialogSaveAs).Title = "Salvar como"
   
    'nome inicial do ficheiro
    Application.FileDialog(msoFileDialogSaveAs).InitialFileName = "teste_2.pdf"
   
    '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)
    'exibe o resultado em uma caixa de mensagem
    End If

End Sub

Se pretende que o nome seja o numero de regiso, pode pedir só para escolher o directório (local destino)

Segue também exemplo de função:

Código:

Public Function LocPastaFicDados(LocalAnterior) As String
' Requer referencia a Microsoft Office 11 Object Library
' 2015 AHTEIXEIRA - maximoaccess

    On Error GoTo PROC_ERR

    If IsNull(LocalAnterior) Then LocalAnterior = ""
   
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   
    fd.Title = "Escolha a pasta"
    fd.Show
   
    If (fd.SelectedItems.Count > 0) Then
        LocPastaFicDados = fd.SelectedItems(1)
        If Right(LocPastaFicDados, 1) <> "\" Then LocPastaFicDados = LocPastaFicDados & "\"
    Else
        LocPastaFicDados = LocalAnterior
    End If
   
PROC_EXIT:
    Exit Function
   
PROC_ERR:
    MsgBox Err.Description
    Resume PROC_EXIT
   
End Function


Abraço

Obrigado Alvaro,
o primeiro exemplo já foi satisfatório para mim.

Agora estou tentando entender porque o Upload do arquivo só está anexando o documento na primeira linha do registro.
Mesmo estando em um novo registro, ele volta no primeiro registro e altera o arquivo anterior, e no registro atual, ele só altera a ID que é automática.

Já viu alguma coisa semenhante?

Olá Diego Jacob,

Ainda não tive oportunidade de fazer algo com o MSSQL como back_end.
Se disponibilizar pequeno exemplo da parte em questão e ;
backup da estrutura da base de dados em SQL ou ficheiro vazio para attach, talvez consiga testar.

Abraço

Alvaro, eu resolvi o problema anterior, incluindo um campo chave que concatena dois campos que nunca se repetirão.
Quanto ao exemplo, eu não sei como poderia disponibilizar, tendo em vista que o SQL server não dá opção.

Quanto ao código abaixo, no lugar do texto "Teste_2.pdf", como eu faria para ele pegar o registro que eu inseri no campo description_file ao fazer o upload na tabela?
Tentei fazer um selec, porém não tive sucesso.

Código:

strReference = Me!frm_ID_Doc_Rev

   DESCRIPTION_NAME = "SELECT [Description_File] , [ID_Doc_Rev] FROM ENG_tbl_Attach_Files WHERE [ID_Doc_Rev] =  '" & strReference & "'"

   'nome inicial do ficheiro
   Application.FileDialog(msoFileDialogSaveAs).InitialFileName = "DESCRIPTION_NAME"

Está ocorrendo erro.

Olá, quanto ao exemplo vamos deixar para o final, quando estiver a funcionar.
Para ajudar poste o código todo do botão.
Abraço

Segue o código do download que está funcionando perfeitamente, só faltando incluir o nome do arquivo gravado em uma tabela.

Código:

Private Sub Download_Nativo_Click()

Dim strFilename As String
Dim strReference As String

strReference = Me!frm_ID_Doc_Rev


''''''Salvar como

   Dim intChoice As Integer
   Dim strPath As String, strSQL As String
   
   
   'nome da caixa de diálogo
   Application.FileDialog(msoFileDialogSaveAs).Title = "Salvar como"
   
   'nome inicial do ficheiro
   Application.FileDialog(msoFileDialogSaveAs).InitialFileName = strSQL ' Aqui eu gostaria de inserir a informação que stá em uma tabela
   
   '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



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

strFilename = strPath

Set cn = CurrentProject.Connection

Set rs = New ADODB.Recordset
rs.Open "SELECT * FROM ENG_tbl_Attach_Files where ID_Doc_Rev = '" & strReference & "'", cn, adOpenKeyset, adLockOptimistic

On Error Resume Next

Set mstream = New ADODB.Stream
mstream.Type = adTypeBinary
mstream.Open
mstream.Write rs.Fields("Attach_Native_File").Value
mstream.SaveToFile (strFilename), adSaveCreateOverWrite

rs.Close
cn.Close


End Sub

Repare bem no codigo que postou.
Você está a tentar atribuir o nome antes de abrir o recordset.
Tente ajustar antes de:

On error....

Ou pode criar uma função fncEscolhecaminho
Para o código ficar melhor.

Abraço

Alvaro,
O "on error resume next" é apenas para não mostrar o erro quando eu clico em cancelar sem selecionar um arquivo qualquer para download, no mais, os códigos estão funcionando perfeitamente.

A única coisa que está faltando, é fazer com que o Select funcione para buscar o nome do arquivo inserido em uma tabela conforme exemplo:

Código:

strReference = Me!frm_ID_Doc_Rev

DESCRIPTION_NAME = "SELECT [Description_File] , [ID_Doc_Rev] FROM ENG_tbl_Attach_Files WHERE [ID_Doc_Rev] = '" & strReference & "'"

'nome inicial do ficheiro
Application.FileDialog(msoFileDialogSaveAs).InitialFileName = "DESCRIPTION_NAME"

Obrigado pela apoio.

Olá o que queria dizer é para colocar na linha anterior a atribuição do nome, porque nessa parte do código já tem acesso ao nome do ficheiro que está na tabela.
Também sugeri que pode criar uma função e chamar dessa linha.

Quanto ao "resume next.." deve evitar:
a) pode fazer tratamento com o código do erro
b) fazer como 2º código de exemplo da mensagem nº 11

Abraço

Alvaro, entendi o seu comentário!
Fiz conforme sugerido e ficou perfeito!

Porém tive que incluir mais algumas condições para adequar ao meu contexto.

Conforme aprendido, aqui deixo o passo a passo, foco do tópico.


Passo 1: CONFIGURAR O FILESTREAM NO SQL SERVER

msdn.microsoft.com/pt-br/library/cc645923(v=sql.120).aspx


Passo 2: INSERIR AS TABELAS FILESTREAM

2.1

Código:

CREATE TABLE tbl_Attach_File
(
[ID_Attach_File] INT IDENTITY(1,1) NOT NULL,
[Attach_PDF_File] VARBINARY(MAX) FILESTREAM NULL,
[Attach_Native_File] VARBINARY(MAX) FILESTREAM NULL,
[FileStreamDataGUID] UNIQUEIDENTIFIER ROWGUIDCOL NOT NULL UNIQUE DEFAULT NEWSEQUENTIALID(),
DateTime DATETIME DEFAULT GETDATE(),
Usuario varchar(50)
)
ON [PRIMARY]
FILESTREAM_ON FileStream
GO

2.2

Código:

create clustered index IX_CLUSTER on tbl_Attach_File(ID_Attach_File)

Passo 3: VINCULAR AS TABELAS NO FRONT END

Passo 4: UPLOAD

Código:


Option Compare Database

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim mstream As ADODB.Stream


Private Sub Button_Native_File_Click()

Dim Filepath As String: Filepath = fncLocalizarArquivo


Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
rs.Open "Select * from ENG_tbl_Attach_File", cn, adOpenKeyset, adLockOptimistic

Set mstream = New ADODB.Stream
mstream.Type = adTypeBinary
mstream.Open
mstream.LoadFromFile (Filepath)
rs.Fields("Attach_Native_File").Value = mstream.Read
rs.Fields("Upload_Date_Native").Value = Now()
rs.Update

rs.Close
cn.Close

End Sub


Passo 5: DOWNLOAD

Código:

Private Sub Download_Nativo_Click()

Dim strReference As String
Dim intChoice As Integer
Dim strPath As String, strSQL As String
Dim strFilename As String
Dim strAttachN As String


   strReference = Me!frm_ID_Doc_Rev 'Referência que você possui no formulário vs referência gravada na tabela

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

   Set cn = CurrentProject.Connection
   
   Set rs = New ADODB.Recordset
   rs.Open "SELECT * FROM ENG_tbl_Attach_Files where ID_Doc_Rev = '" & strReference & "'", cn, adOpenKeyset, adLockOptimistic
   
   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("Description_Native_File")
   strAttachN = rs.Fields("Attach_Native_File").Value
   
   If strAttachN = "" Then
       MsgBox "Documento não disponível para download!", vbInformation, "SCE - Download"
       Me.Form.Requery
       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("Attach_Native_File").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, "SCE - Download") = vbYes Then
           Shell "explorer.exe " & strPath, vbMaximizedFocus
       End If
           
   End If

   
Fim:

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

End Sub


Alvaro,
muito obrigado pelas contribuições, as quais foram essenciais para que as funções dessem certo.

Favor finalizar o tópico, pois não estou conseguindo.
Obrigado.

Diego

Olá Diego, conseguiu  
Ok, desta vez eu coloco, no entanto veja como dar o tópico como resolvido.
Tomei a liberdade de "dar um jeito" na mensagem anterior de forma a ficar mais fácil a sua leitura e compreensão.

Obrigado pelo retorno e partilha do exemplo.
No meu entender, para o exemplo ficar completo, sugiro que poste também a função fncLocalizarArquivo.

Abraço

Ok Mr. Alvaro,
muito legal essa formatação que você fez com os códigos, com certeza fica melhor, mais organizado.

Conforme solicitado, segue a função "fncLocalizarArquivo", esse exemplo eu consegui com outro grande colaborador, Avelino Sampaio, ele usa no Maestro, muito legal.

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 = "c:\"
   .InitialView = msoFileDialogViewPreview
   If .Show Then
       fncLocalizarArquivoPDF = .SelectedItems(1)
   End If
End With
sair:
   Exit Function
trataerro:
   fncLocalizarArquivoPDF = ""
   Resume sair:
   
End Function



Obrigado.

Diego

Olá Diego Jacob,

Obrigado pela partilha e mencionar a origem e autor da função, o nosso colega Mestre Avelino.
Ficou um excelente tópico, isto é que é ser MaximoAccess.