'https://usefulgyaan.wordpress.com/2014/09/30/store-and-fetch-files-sql-server-tables/
'modified by arnelgp to accept variables as parameter and for MySQL
'To save a file in a table as binary
'
'Parameters:
'
' strServerName = server name
' strDb = database name
' tableName = table that holds the image
' blobfield = the field that holds the image
' strFilePath = the image filename and location
' IsMySQL = true or false, if you are using MySQL set this parameter to True
'
Sub SaveAsBinary( _
ByVal strServerName As String, _
ByVal strDB As String, _
ByVal tableName As String, _
ByVal blobField As String, _
ByVal strFilePath As String, _
Optional ByVal IsMySQL As Boolean = False)
Dim adoStream As Object
Dim adoCmd As Object
Dim adoCon As Object
'Dim strFilePath As String
'Const strDB As String = "" 'Database name
'Const strServerName As String = "" 'Server Name
Set adoCon = CreateObject("ADODB.Connection")
Set adoStream = CreateObject("ADODB.Stream")
Set adoCmd = CreateObject("ADODB.Command")
'arnelgp
Dim adoRecorset As Object
Set adoRecorset = CreateObject("ADODB.Recordset")
'--Open Connection to SQL server
adoCon.CursorLocation = adUseClient
'arnelgp
If IsMySQL Then
'change the UID (userid) and pwd (password)
adoCon.Open "DRIVER={MySQL ODBC 8.0 Unicode Driver};SERVER=" & strServerName & ";DATABASE=" & strDB & ";UID=root;PWD=;OPTION=16427"
Else
adoCon.Open "Provider=SQLOLEDB;Data Source=" & strServerName & ";Initial Catalog = " & strDB & ";Integrated Security=SSPI;"
End If
'----
'strFilePath = "C:\1.JPG" ' File to upload
adoStream.Type = adTypeBinary
adoStream.Open
adoStream.LoadFromFile strFilePath 'It fails if file is open
If Not IsMySQL Then
With adoCmd
'.CommandText = "INSERT INTO Employee VALUES (?,?)" ' Query
.CommandText = "INSERT INTO [" & tableName & "] (" & blobField & ") VALUES (?)" ' Query
.CommandType = adCmdText
'---adding parameters
'.Parameters.Append .CreateParameter("@Id", adInteger, adParamInput, 0, 1)
.Parameters.Append .CreateParameter("@Image", adVarBinary, adParamInput, adoStream.Size, adoStream.Read)
'---
End With
adoCmd.ActiveConnection = adoCon
adoCmd.Execute
Else
adoRecorset.Open tableName, adoCon, adOpenKeyset, adLockPessimistic, adCmdTable
With adoRecorset
.AddNew
.Fields(blobField) = adoStream.Read
.Update
.Close
End With
End If
adoCon.Close
End Sub
'https://usefulgyaan.wordpress.com/2014/09/30/store-and-fetch-files-sql-server-tables/
'modified by arnelgp to accept variables as parameter and for MySQL
'To read binary stream from DB and save the same on system drive
'
'Parameters:
'
' strServerName = server name
' strDb = database name
' tableName = table that holds the image
' pkName = the primary key field name
' pkValue = the value of the PK where the image is to be fetch
' blobfield = the field that holds the image
' strFilePath = the image filename and location
' IsMySQL = true or false, if you are using MySQL set this parameter to True
'
Sub ReadBinary( _
ByVal strServerName As String, _
ByVal strDB As String, _
ByVal tableName As String, _
ByVal pkName As String, _
ByVal pkValue As Long, _
ByVal blobField As String, _
ByVal strFilePath As String, _
Optional ByVal IsMySQL As Boolean = False)
Dim adoRs As Object
Dim adoStream As Object
Dim adoCon As Object
'Const strDB As String = "" 'Database name
'Const strServerName As String = "" 'Server Name
Set adoCon = CreateObject("ADODB.Connection")
Set adoRs = CreateObject("ADODB.Recordset")
Set adoStream = CreateObject("ADODB.Stream")
'--Open Connection to SQL server
adoCon.CursorLocation = adUseClient
'arnelgp
'not working on MySQL part!!!!!!!!!!
If IsMySQL Then
'change the UID (userid) and pwd (password)
adoCon.Open "DRIVER={MySQL ODBC 8.0 Unicode Driver};SERVER=" & strServerName & ";DATABASE=" & strDB & ";UID=root;PWD=;OPTION=16427"
adoRs.Open "SELECT " & blobField & " FROM " & tableName & " WHERE " & pkName & " = " & pkValue & ";", adoCon, adOpenStatic, adLockOptimistic
Else
adoCon.Open "Provider=SQLOLEDB;Data Source=" & strServerName & ";Initial Catalog = " & strDB & ";Integrated Security=SSPI;"
adoRs.Open "SELECT " & pkName & ", " & blobField & " FROM " & tableName & " WHERE " & pkName & " = " & pkValue & ";", adoCon, adOpenStatic, adLockOptimistic
End If
adoStream.Type = adTypeBinary
adoStream.Open
adoStream.Write adoRs(blobField).Value '.Value ' FieldName that contains binary data
adoStream.SaveToFile strFilePath, adSaveCreateOverWrite
'--
adoRs.Close
adoCon.Close
End Sub
