sql-servervbams-accessfilestreamsqlfilestream

MS Access / SQL Server - VBA: Upload local file to filestream on remote SQL server


I need to upload a file (<10 MB) around once a week to a SQL Server 2016 database on a remote server in the same network. Until now it was all within a Access FE/BE but I want to migrate to SQL Server as backend.

The attachments I had in MS Access so need to be handled now on the SQL database as I do not want to do this on a fileshare.

I found many threads about using something like this from SQLShack

DECLARE @File varbinary(MAX);  

SELECT  
    @File = CAST(bulkcolumn AS varbinary(max))  
FROM  
    OPENROWSET(BULK 'C:\sqlshack\akshita.png', SINGLE_BLOB) as MyData; 
 
INSERT INTO DemoFileStreamTable_1  
VALUES  (NEWID(), 'Sample Picture', @File)

This works when I start the query within SSMS on the SQL Server itself and the file is already accessible by the server on its local drive.

But when I try to put this in my VBA code on my Access frontend computer:

Sub DaoOdbcExample()
    Dim cdb As DAO.Database, qdf As DAO.QueryDef
    Set cdb = CurrentDb
    Set qdf = cdb.CreateQueryDef("")
    qdf.Connect = "ODBC;" & _
            "Driver={SQL Server};" & _
            "Server=MyServer;" & _
            "Database=MyDatabase;" & _
            "Trusted_Connection=yes;"
    qdf.SQL = "DECLARE @File varbinary(MAX); SELECT @File = CAST(bulkcolumn as varbinary(max))  FROM  OPENROWSET(BULK 'D:\SomeFile.pdf', SINGLE_BLOB) as MyData; INSERT INTO DemoFileStreamTable_1  VALUES  (  NEWID(),  'Test PDF',  @File)"
    qdf.ReturnsRecords = False
    qdf.Execute dbFailOnError
    Set qdf = Nothing
    Set cdb = Nothing
End Sub

I just get an error

ODBC--call failed

Other simple "Select" statements seem to work, so the connection itself seems okay.

So my questions are:

  1. How can I perform such an upload from a local file on computer A to the remote SQL server on computer B (which cannot directly access this file) using MS Access as my frontend?

  2. Is there a different way not using the "BULK" statement as I need "bulkadmin" rights for all users then?


Solution

  • I may have found a solution using the links from @AlwaysLearning. The first sub actually answers my question to upload a file to a remote FILESTREAM SQL Server. The second sub downloads all uploaded files into a given directory.

    Private Sub btn_AddAtachment_Click()
        Dim cn, rs  As Object
        Dim sql, strCnxn, FileToUpload, FileName As String
    
        'FileSystemObject to do so some file checks
        Dim fso As Object
        Set fso = VBA.CreateObject("Scripting.FileSystemObject")
        
        'select file to upload, will open a FileOpenDialog
        FileToUpload = CustOpenFileDialog
        If FileToUpload <> "" Then
            FileName = fso.GetFileName(FileToUpload) 'get only filename + extension
             
            'SQL Connection
            strCnxn = "Provider=sqloledb;" & _
            "Data Source=MYSERVER;" & _
            "Initial Catalog=MYDATABASE;" & _
            "Integrated Security=SSPI;" 'Windows-Authentication
             
            Set cn = CreateObject("ADODB.Connection")
            cn.Open strCnxn
             
            'Recordset
            sql = "DemoFileStreamTable_1" 'Table to add file
            Set rs = CreateObject("ADODB.Recordset")
            rs.Open sql, strCnxn, 1, 3  '1 - adOpenKeyset, 3 - adLockOptimistic"
             
            'Create Stream to upload File as BLOB data
            Dim strm As Object
            Set strm = CreateObject("ADODB.Stream")
            strm.Type = 1 '1 - adTypeBinary
            strm.Open
            strm.LoadFromFile FileToUpload
            
            'Insert into database
            rs.AddNew 'FileId will be automatically handled by SQL
            rs!File = strm.Read
            rs!FileName = FileName
            strm.Close
            rs.Update
        End If
    End Sub
    
    Private Sub btn_DwnldSQL_Click()
        Dim cn, rs  As Object
        Dim sql As String
        Dim oStream As Object
        Dim OutputPath, strCnxn, FileName, SaveLocation As String
        
        OutputPath = "D:\ExportTest"
        
        'FileSystemObject to do so some file checks
        Dim fso As Object
        Set fso = VBA.CreateObject("Scripting.FileSystemObject")
        
        'SQL Connection
        Set cn = CreateObject("ADODB.Connection")
        strCnxn = "Provider=sqloledb;" & _
        "Data Source=MYSERVER;" & _
        "Initial Catalog=MYDATABASE;" & _
        "Integrated Security=SSPI;" 'Windows-Authentication
        
        cn.Open strCnxn 
        
        'your sql statment including varbinary max field here it is File
        sql = " SELECT [File],[FileName] from [DemoFileStreamTable_1] "
        
        'Recordset
        Set rs = CreateObject("ADODB.Recordset")
        rs.Open sql, cn
        
        'Actual Download
        Do Until rs.EOF 'Read all rows
            Set oStream = CreateObject("ADODB.Stream")
            FileName = CStr(rs.Fields("FileName").Value) 'FileName from Database field
            SaveLocation = fso.BuildPath(OutputPath, FileName) 'Create outputpath
            With oStream
                 .Type = 1 '1 - adTypeBinary
                 .Open
                 .Write rs.Fields("File").Value 'actual BLOB data
                 .SaveToFile SaveLocation, 2 '2 - adSaveCreateOverWrite
                 .Close
            End With
            Set oStream = Nothing
            rs.MoveNext
        Loop
        rs.Close
        cn.Close
    End Sub
    
    Function CustOpenFileDialog() As String 
        Const msoFileDialogFilePicker As Long = 3
        Dim objDialog As Object
        Set objDialog = Application.FileDialog(msoFileDialogFilePicker)
        Dim fso As Object
        Set fso = VBA.CreateObject("Scripting.FileSystemObject")
        Dim FileName As String
    
        With objDialog
            .AllowMultiSelect = False
            ' Set the title of the dialog box.
            .Title = "Please select one file"
            ' Clear out the current filters, and add our own.
            .Filters.Clear
            .Filters.Add "supported Types", "*.pdf, *.xml, *.gltf, *.jpg, *.png"
     
            ' Show the dialog box. If the .Show method returns True, the
            ' user picked at least one file. If the .Show method returns
            ' False, the user clicked Cancel. 
            If .Show = True Then
                CustOpenFileDialog = .SelectedItems(1)
            Else
                CustOpenFileDialog = ""
            End If
        End With
    End Function