Save and Retrieve Files from SQL Server using Excel VBA


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!








1 comentario:

  1. Excelente, se puede aprender mucho con este ejemplo. Muchas gracias.

    ResponderEliminar