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

Click aquí: Primera Parte de clase transmitida en vivo

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

Click aquí: Segunda Parte de clase transmitida en vivo

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:

• Query que crea la base de datos y el procedimiento almacenado
• Cliente de Conexión de Excel para guardar y recuperar ficheros desde SQL Server

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!

Enviar correos electrónicos con la Función HIPERVINCULO

Ya todos conocemos la función HIPERVINCULO, y estoy seguro que ustedes la han utilizado infinidad de veces para crear enlaces a sus sitios web favoritos.

Esta función además de facilitarnos la tarea de darnos acceso a nuestros sitios web, también podemos crear enlaces que nos dirijan a distintos lugares dentro de un libro de trabajo.

Y por supuesto también, podríamos tener acceso a otros archivos de nuestro disco local.

Pero el objetivo de este tip, es mostrarles lo sencillo que es, estructurar en una hoja de cálculo, una plantilla que nos permita enviar correos electrónicos desde Excel. Obviamente esto funcionará siempre y cuando tengamos instalada una aplicación cliente de correo, como Microsoft Outlook o en su defecto, la aplicación de correo que ya viene integrada en Windows 8 y en Windows 10.

En el siguiente enlace a YouTube, te muestro paso a paso de cómo lograr el resultado, según la ilustración que te muestro al inicio de este publicación.

Mira el Vídeo AQUÍ

Descarga el archivo base que utilicé para realizar el ejemplo AQUÍ

Si esta publicación te gustó, compártelo con tus amigos, y te invito a que te suscribas a youtube.excelymas.com es totalmente gratis.

Capturar Datos mediante la función InputBox

Muchas veces cuando capturamos datos en una hoja de cálculo, requerimos de una automatización, y la forma habitual sería crear un UserForm con TextBoxes insertados y de esa forma recopilar la información de una forma automatizada. Sin embargo, la creación de un UserForm nos podría llevar demasiado tiempo en implementar, por lo que en este post, les traigo una forma práctica para automatizar la captura de datos utilizando la función InputBox.

Lo único que tienes que hacer, es dirigirte al entorno VBA, insertar un nuevo módulo y pegar el siguiente código. Recuerda que lo puedes personalizar según tus necesidades.

Sub CapturarDatos()
Dim f As Long
Dim Entrada1 As String
Dim Entrada2 As String
Dim Entrada3 As String


Do
    f = Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    Entrada1 = InputBox("Código:")
    If Entrada1 = Empty Then Exit Sub
    
    Entrada2 = InputBox("Descripción:")
    If Entrada2 = Empty Then Exit Sub
    
    Entrada3 = InputBox("Existencia:")
    If Entrada3 = Empty Then Exit Sub
    

    Cells(f, 1) = Entrada1
    Cells(f, 2) = Entrada2
    Cells(f, 3) = Entrada3
    
    Hoja1.Range("A1").CurrentRegion.Sort Key1:=Hoja1.Range("A1"), Header:=xlYes

Loop
End Sub

Pera comprender mejor su funcionamiento, te invito a ver el vídeo completo en YouTube AQUÍ
Además puedes descargar el archivo base desde AQUÍ


Si el contenido te gustó, compártelo con tus amigos en las diferentes redes sociales.
Saludos cordiales!

Controles ActiveX | TextBox | Características Principales

En La mayoría de los desarrollos que realicemos en VBA, siempre tendremos la necesidad de utilizar un TextBox, ya sea como medio de entrada para enviar datos a una hoja de cálculo, o para mostrar datos como resultado de una consulta o simplemente para obtener el cálculo de una operación aritmética. En fin, las posibilidades pueden ser diversas.

En este capítulo conoceremos las propiedades más relevantes de un TextBox, y por las cuales nos resulta de mucha importancia, la utilización de este tipo de controles para nuestros proyectos.

A continuación tenemos un código de programación VBA con el cual podrán hacer un sencillo formulario de captura de datos...

Private Sub CommandButton1_Click()
    Dim f As Long
    
    If TextBox1 = Empty Then
        MsgBox "Debe ingresar un nombre de cliente"
        TextBox1.SetFocus
        Exit Sub
        ElseIf TextBox2 = Empty Then
        MsgBox "Debe ingresar un ocrreo electrónico"
        TextBox2.SetFocus
        Exit Sub
    End If

If Cells(1, 13) = Empty And Cells(1, 14) = Empty Then
    Cells(1, 13) = "Nombre del Cliente"
    Cells(1, 13).Font.Bold = True
    Cells(1, 14) = "Correo electrónico"
    Cells(1, 14).Font.Bold = True
End If
    
    f = Cells(Rows.Count, 13).End(xlUp).Row + 1
    
    Cells(f, 13) = TextBox1.Text
    Cells(f, 14) = TextBox2.Text
    
    TextBox1 = Empty
    TextBox2 = Empty
    
    TextBox1.SetFocus
End Sub

Te invito a ver el vídeo en YouTube y conozcas las características principales de este control ActiveX

Ver vídeo

Descarga Archivo Base