Guardar y Recuperar Ficheros desde SQL Server usando Excel VBA
Cuando trabajamos en bases de datos, y dependiendo de la información que manejemos, así tendremos la necesidad de agregarle algún tipo de archivo que le dé una mayor descripción al registro almacenado.
Como por ejemplo si llevamos un control de inventarios, será muy útil tener la fotografía de cada uno de los productos. O si manejamos los datos del personal de la empresa, pues obviamente necesitaremos consultar la fotografía de cada empleado y así conocerlos a cada uno de ellos, no solo como un nombre en la base de datos, sino, poniendo un rostro a dicho nombre.
Pues bien… esta vez he creado una rutina que nos permite almacenar archivos en una tabla… pero no como documento adjunto… sino, como un archivo convertido en formato binario, lo cual nos da la flexibilidad de recuperar esa información, ya sea, en una red local, o desde una red remota.
Es un sencillo UserForm que consta de dos botones, con las rutinas necesarias para lograr nuestro objetivo.
En el siguiente enlace encontrarás la primera transmisión que realicé en vivo y ahí vimos el funcionamiento de este proyecto, dando recomendaciones específicas de lo que debemos hacer, cuando tendremos que guardar ficheros en un servidor remoto de Microsoft Azure
emitido el 21 de Junio de 2017
En dicha transmisión vimos lo fácil que es recuperar ficheros desde un servidor remoto de Azure, los cuales se encuentran en un campo del tipo varbinary
El siguiente Query es el que utilicé para crear la base de datos y la tabla correspondiente, haciendo uso de un Procedimiento Almacenado para realizar la inserción de cada registro.
La importación masiva de datos binarios desde un servidor remoto, la hace posible la función OPENROWSET y la instrucción BULK INSERT. Checa el quiery, y puedes ver la forma en que hago la inserción de un fichero en particular.
Copia y pega todo el script en una nueva consulta de tu servidor SQL y ejecútala.
Haz pruebas insertando ficheros de forma local mediante el procedimiento almacenado, pasándole los argumento que te solicita y verás lo simple que es.
Checa la transmisión en vivo que realizamos según el enlace que te he dejado más arriba, y podrás ver la forma de hacerlo hacia un servidor remoto de Azure.
create database inventario
GO
use inventario
GO
create table archivos
(
id_archivo int identity primary key,
tipo_archivo varchar(4) not null,
descripcion varchar(100) not null,
fichero varbinary(max)
)
GO
CREATE PROCEDURE SP_AlmacenarArchivo
@TipoArchivo varchar(4),
@Descripcion varchar(100),
@Fichero varchar(max)
as
exec ( 'insert into archivos values(''' + @TipoArchivo + ''','''+ @Descripcion +''',
(SELECT * FROM OPENROWSET(BULK N''' + @Fichero + ''', SINGLE_BLOB) as x));' );
GO
--Con esta línea hago una prueba de inserción de un registro mediante el procedimiento almacenado
exec SP_AlmacenarArchivo 'PDF','LISTADO DE PRODUCTOS POR COMPRAR', 'C:\img\inventario.pdf'
En la siguiente entrega en YouTube, realicé otra transmisión en vivo, en donde les entregué a los asistentes en primicia, el proyecto de Excel completo, el cual contiene las rutinas que gestionan los datos mediante código de programación VBA
emitido el 26 de Junio de 2017
El siguiente es el código de programación contenido en el UserForm que te mostré al inicio de este Post.
Cada rutina está insertada en su respectivo botón del Formulario.
Option Explicit
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim RutaFichero As String
Dim TipoArchivo As String
Private Sub btnGuardaFichero_Click()
Dim FdBox As FileDialog
Dim Selection As Boolean
Dim sDescription As String
On Error GoTo Salir
If Me.btnGuardaFichero.Caption = "Seleccionar fichero" Then
Set FdBox = Application.FileDialog(msoFileDialogFilePicker)
FdBox.Filters.Clear
FdBox.Filters.Add "Imágenes jpg", "*.jpg"
FdBox.Filters.Add "Imágenes png", "*.png"
FdBox.Filters.Add "Imágenes pdf", "*.pdf"
FdBox.Filters.Add "Libro de Excel xlsx", "*.xlsx"
FdBox.Filters.Add "Libro de Excel habilitado para macros xlsm", "*.xlsm"
FdBox.FilterIndex = 1
FdBox.AllowMultiSelect = False
Selection = FdBox.Show
If Not Selection Then
Exit Sub
End If
RutaFichero = FdBox.SelectedItems(1)
TipoArchivo = RutaFichero
TipoArchivo = Mid(TipoArchivo, InStrRev(TipoArchivo, ".") + 1, 4)
Me.btnGuardaFichero.Caption = "Guardar fichero"
Me.btnRecuperarFichero.Caption = "Cancelar"
Me.lbl_Msg.Visible = True
Me.lbl_Msg.Caption = "Fichero seleccionado: " & RutaFichero
Exit Sub
End If
If Me.btnGuardaFichero.Caption = "Guardar fichero" Then
sDescription = InputBox("Escriba una descripción para el fichero:")
If sDescription = Empty Then
MsgBox "Debe escribir una descripción para del fichero"
Exit Sub
End If
If MsgBox("Seguro que desea guardar este fichero en la base de datos", vbYesNo + vbQuestion) = vbYes Then
Conn.Execute "exec SP_AlmacenarArchivo '" & TipoArchivo & "','" & sDescription & "','" & RutaFichero & "'"
MsgBox "Fichero almacenado en la tabla Archivos"
Me.btnGuardaFichero.Caption = "Seleccionar fichero"
Me.btnRecuperarFichero.Caption = "Recuperar fichero"
Me.lbl_Msg.Visible = False
Else
Me.btnGuardaFichero.Caption = "Seleccionar fichero"
Me.btnRecuperarFichero.Caption = "Recuperar fichero"
sDescription = Empty
Me.lbl_Msg.Visible = False
Exit Sub
End If
End If
Salir:
If Err <> 0 Then
MsgBox Err.Description, vbCritical
End If
End Sub
Private Sub btnRecuperarFichero_Click()
Dim sql As String
Dim idArchivo As String
Dim x As Long
On Error GoTo Salir
If Me.btnRecuperarFichero.Caption = "Cancelar" Then
Me.btnGuardaFichero.Caption = "Seleccionar fichero"
Me.lbl_Msg.Visible = False
Me.btnRecuperarFichero.Caption = "Recuperar fichero"
Exit Sub
End If
Set Rst = New ADODB.Recordset
Set stm = New ADODB.Stream
idArchivo = InputBox("Escriba el ID del fichero a recuperar:")
If idArchivo = Empty Then Exit Sub
sql = "SELECT * FROM archivos WHERE id_archivo=" & idArchivo
Rst.Open sql, Conn
stm.Type = adTypeBinary
stm.Open
stm.Write Rst("fichero").Value
TipoArchivo = Rst("tipo_archivo").Value
stm.SaveToFile "C:\Temp\Temp." & TipoArchivo, adSaveCreateOverWrite
If TipoArchivo = "xlsx" Or TipoArchivo = "xlsm" Then
Workbooks.Open Filename:="C:\Temp\Temp." & TipoArchivo
Else
x = ShellExecute(0, "Open", "C:\Temp\Temp." & TipoArchivo, vbNullString, vbNullString, 1)
End If
Salir:
If Err <> 0 Then
MsgBox Err.Description, vbCritical
End If
End Sub
Private Sub UserForm_Initialize()
Me.lbl_Msg.Visible = False
Me.btnGuardaFichero.Caption = "Seleccionar fichero"
End Sub
En la segunda parte de esta emisión te doy explicación de cada una de las líneas que involucran el guardar y recuperar ficheros desde SQL Server.
Ya para finalizar este breve sondeo, te dejo los enlaces de descarga del Query y el proyecto de Excel completo. Y te invito a ver el contenido en YouTube para que tengas una mejor percepción de cómo trabaja el cliente de conexión de Excel.
Enlaces de descarga:
Si esta publicación te gustó, compártela con tus amigos... y te invito a que te suscribas a youtube.excelymas.com en donde encontrarás contenido audivisual totalmente gratuito.
Nos vemos en la próxima entrega.
¡Saludos!
