MS Access / SQL 服务器 - VBA:将本地文件上传到远程 SQL 服务器上的文件流
MS Access / SQL Server - VBA: Upload local file to filestream on remote SQL server
我需要大约每周一次将文件 (<10 MB) 上传到同一网络中远程服务器上的 SQL Server 2016 数据库。到目前为止,它都在 Access FE/BE 中,但我想迁移到 SQL 服务器作为后端。
我在 MS Access 中的附件现在需要在 SQL 数据库上处理,因为我不想在文件共享上执行此操作。
我从 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)
当我在 SQL 服务器本身的 SSMS 中启动查询并且该文件已经可以由服务器在其本地驱动器上访问时,这有效。
但是当我尝试将其放入我的 Access 前端计算机上的 VBA 代码中时:
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
我刚收到一个错误
ODBC--call failed
其他简单的“Select”语句似乎有效,因此连接本身似乎没问题。
所以我的问题是:
如何使用 MS Access 作为我的前端,将计算机 A 上的本地文件上传到计算机 B 上的远程 SQL 服务器(无法直接访问该文件) ?
有没有不使用“BULK”语句的不同方法,因为我需要所有用户的“bulkadmin”权限?
我可能已经使用来自@AlwaysLearning 的链接找到了解决方案。
第一个子实际上回答了我将文件上传到远程 FILESTREAM SQL 服务器的问题。
第二个子将所有上传的文件下载到给定目录。
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
我需要大约每周一次将文件 (<10 MB) 上传到同一网络中远程服务器上的 SQL Server 2016 数据库。到目前为止,它都在 Access FE/BE 中,但我想迁移到 SQL 服务器作为后端。
我在 MS Access 中的附件现在需要在 SQL 数据库上处理,因为我不想在文件共享上执行此操作。
我从 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)
当我在 SQL 服务器本身的 SSMS 中启动查询并且该文件已经可以由服务器在其本地驱动器上访问时,这有效。
但是当我尝试将其放入我的 Access 前端计算机上的 VBA 代码中时:
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
我刚收到一个错误
ODBC--call failed
其他简单的“Select”语句似乎有效,因此连接本身似乎没问题。
所以我的问题是:
如何使用 MS Access 作为我的前端,将计算机 A 上的本地文件上传到计算机 B 上的远程 SQL 服务器(无法直接访问该文件) ?
有没有不使用“BULK”语句的不同方法,因为我需要所有用户的“bulkadmin”权限?
我可能已经使用来自@AlwaysLearning 的链接找到了解决方案。 第一个子实际上回答了我将文件上传到远程 FILESTREAM SQL 服务器的问题。 第二个子将所有上传的文件下载到给定目录。
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