Consultoría profesional en Excel... Expertos en Excel.

Un buen consejo: Empieza octubre con buen pie... no dejes de aprender Excel...

Consultoría profesional para empresas y particulares. Por un trato personal, adaptado a tus necesidades, con el compromiso Excelforo.
Por que tu tiempo vale mucho.

Cursos de Excel y Macros en modalidad elearning, para permitir el acceso a ellos a cualquier persona desde cualquier parte del mundo...
No lo dudes y haz de Excel tu mejor aliado!
Aprende con los mejores y adquiere una buena base: Edición de Cursos de Excel y Macros online con tutor personal de Octubre de 2015.
Nunca estudiar fue tan fácil.

Los cursos de Excel y Macros abiertos para este mes de Octubre son:

Curso Excel Avanzado

(ver más)

Curso Macros Medio

(ver más)

Curso Macros Iniciación

(ver más)

Curso Excel Nivel Medio

(ver más)

Curso Tablas dinámicas en Excel

(ver más)

Curso preparación MOS Excel 2010 (Examen 77-882)

(ver más)

Curso Excel Financiero

(ver más)

Curso Excel Presencial en Madrid nivel Avanzado - 20 horas -

(ver más)

Esta nueva edición de Cursos de Excel y macros en modalidad elearning (online) comienzan el día 1 de Octubre de 2015; y la matrícula estará abierta hasta el día 10.

Excelforo: con la confianza de siempre....estás a tiempo!!

También formación Excel a empresas. Explota los recursos a tu alcance (ver más).

Informarte sin compromiso en cursos@excelforo.com o directamente en www.excelforo.com.

Seguir leyendo...

VBA: El método .CopyFolder o cómo COPIAR una carpeta de una ubicación a otra.

Como continuación al post del día anterior (el uso de método .MoveFolder), se plantea la cuestión sobre cuál sería la manera de COPIAR (no mover) carpetas entre distintas ubicaciones.

La respuesta, similar a la de post anterior, sería empleando el Objeto "Scripting.FileSystemObject", y para este caso concreto, un método asociado: .CopyFolder.
Es importante mencionar, que si la Carpeta origen contiene caracteres comodín o la Carpeta destino finaliza con un separador de ruta (barra invertida '\'), se supone que esta Carpeta destino es una carpeta existente en la que copiar las carpetas y subcarpetas coincidentes.
En caso contrario, se supone que la Carpeta destino es el nombre de una carpeta que se va a crear.

En cualquier caso, pueden ocurrir cuatro cosas cuando copiamos una carpeta:
1-Caso más habitual. Si no existe la Carpeta destino, se copian la carpeta origen y todo su contenido.
2-Si la Carpeta destino es un archivo existente, se produce un error.
3-Si la Carpeta destino es un directorio, se hace un intento de copiar la carpeta y todo su contenido. Si existe ya en la Carpeta destino un archivo contenido en la Carpeta origen, se produce un error si sobrescribir es False. Si no, se intentará copiar el archivo sobre el archivo existente.
4-Si la Carpeta destino es un directorio de sólo lectura, se produce un error si se hace un intento de copiar un archivo de sólo lectura existente en ese directorio y sobrescribir es False.

Con estas premisas, ya estamos en disposición de incorporar el código necesario...
Si vemos nuestro explorador de Windows, observamos la carpeta que deseamos copiar y pegar:
E:\excelforo\00CarpetaVieja

Insertamos nuestro código en un módulo estándar de nuestro proyecto de VBA desde el editor de VB:

Sub Copiar_Carpeta()
'Para COPIAR una carpeta en cualquier otra Ubicación

Dim CarpetaOrigen As String, CarpetaDestino As String
'Indicamos los nombres y ubicaciones de la Carpeta a COPIAR...
CarpetaOrigen = "E:\excelforo\00CarpetaVieja"
CarpetaDestino = "E:\excelforo\00CarpetaNueva" & "_" & Format(Now(), "dd_mm_yyyy_hh_mm")
'OJO!!!: no podremos crear una carpeta ya existente!!!

'con este objeto proporcionamos acceso al sistema de archivos de nuestro equipo...
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")

'controlamos que no hayamos terminado nuestra ruta con barra invertida \
'ni en la Carpeta Vieja
If Right(CarpetaOrigen, 1) = "\" Then
    CarpetaOrigen = Left(CarpetaOrigen, Len(CarpetaOrigen) - 1)
End If
'ni en la Nueva
If Right(CarpetaDestino, 1) = "\" Then
    CarpetaDestino = Left(CarpetaDestino, Len(CarpetaDestino) - 1)
End If
'También verificamos que existe la carpeta original a mover...
If FSO.FolderExists(CarpetaOrigen) = False Then
    MsgBox "EH!!!, esta " & CarpetaOrigen & " no existe!!!"
    Exit Sub
End If
'y que NO existe el destino....
If FSO.FolderExists(CarpetaDestino) = True Then
    MsgBox "Atención!!! la Carpeta" & CarpetaDestino & " ya existe..." & vbCrLf & _
    ", y NO es posible desplazarla a una Carpeta ya existente!!!"
    Exit Sub
End If

'Momento para copiar y pegar la ubicación de la Carpeta.
'Empleamos el método CopyFolder para copiar de un lugar a otro...
FSO.CopyFolder Source:=CarpetaOrigen, Destination:=CarpetaDestino

'mensaje de confirmación
MsgBox "Hemos copiado la Carpeta " & CarpetaOrigen & " y pegado en la nueva ubicación " & CarpetaDestino
End Sub

Tras ejecutar nuestra macro vemos como se ha producido el copiado y pegado (con nombre distinto) de nuestra carpeta origen....

Seguir leyendo...

VBA: El método .MoveFolder o cómo cambiar Carpetas de ubicación.

Hace unas semanas un lector me planteaba la siguiente pregunta:

...necesito cambiar la ubicación de una carpeta en otra ubicación, pero reemplazando el nombre original por la fecha y hora del sistema. Por ej si la carpeta se llama balance, se copia y se pega con el nombre 21-07-2015 16:15, y así todas las veces que pegue una nueva carpeta sin sobreescribirla ya que sera distintas por la fecha del sistema.

La idea, parece por tanto clara, ¿podemos desde Excel gestionar la creación y/o renombrar Carpetas de nuestros directorios?.
La respuesta, obviamente, es que sí.. empleando el Objeto "Scripting.FileSystemObject", y para este caso concreto, un método asociado: .MoveFolder.
Es importante mencionar, de hecho existen algunos controles en la propia macro, que el nuevo nombre de la carpeta NO puede existir!!.
Con esta premisa, ya estamos en disposición de incorporar el código necesario...
Si vemos nuestro explorador de Windows, observamos la carpeta que deseamos cambiar:
E:\excelforo\00CarpetaVieja

Insertamos nuestro código en un módulo estándar de nuestro proyecto de VBA desde el editor de VB:

Sub Reubicar_Carpeta()
'Para MOVER una carpeta de una Ubicación a otra...

Dim RutaCarpetaVieja As String, RutaCarpetaNueva As String
'Indicamos los nombres y ubicaciones de la Carpeta a mover...
RutaCarpetaVieja = "E:\excelforo\00CarpetaVieja"
RutaCarpetaNueva = "E:\excelforo\00CarpetaNueva"
'OJO!!!: no podremos crear una carpeta ya existente!!!

'con este objeto proporcionamos acceso al sistema de archivos de nuestro equipo...
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")

'controlamos que no hayamos terminado nuestra ruta con barra invertida \
'ni en la Carpeta Vieja
If Right(RutaCarpetaVieja, 1) = "\" Then
    RutaCarpetaVieja = Left(RutaCarpetaVieja, Len(RutaCarpetaVieja) - 1)
End If
'ni en la Nueva
If Right(RutaCarpetaNueva, 1) = "\" Then
    RutaCarpetaNueva = Left(RutaCarpetaNueva, Len(RutaCarpetaNueva) - 1)
End If
'También verificamos que existe la carpeta original a mover...
If FSO.FolderExists(RutaCarpetaVieja) = False Then
    MsgBox "EH!!!, esta " & RutaCarpetaVieja & " no existe!!!"
    Exit Sub
End If
'y que NO existe el destino....
If FSO.FolderExists(RutaCarpetaNueva) = True Then
    MsgBox "Atención!!! la Carpeta" & RutaCarpetaNueva & " ya existe..." & vbCrLf & _
    ", y NO es posible desplazarla a una Carpeta ya existente!!!"
    Exit Sub
End If

'Momento para cambiar la ubicación de la Carpeta.
'Empleamos el método MoveFolder para mover de un lugar a otro...
FSO.MoveFolder Source:=RutaCarpetaVieja, Destination:=RutaCarpetaNueva

'mensaje de confirmación
MsgBox "Hemos movido la Carpeta " & RutaCarpetaVieja & " hasta la nueva ubicación " & RutaCarpetaNueva

End Sub

Y tras ejecutar nuestro procedimiento obtendríamos la nueva Carpeta..., por supuesto, la vieja ha desaparecido...

Seguir leyendo...

Encontrar la última fila o columna con datos...

Aprenderemos hoy un truco bastante útil que nos servirá para localizar cuál es la última celda de un rango con un valor...
y lo haremos con un sentido o final concreto, ser capaces de adaptar el área de impresión de manera particular a un rango definido.
La explicación viene al hilo de una cuestión planteada en un foro en el que participo:

Necesito una macro que seleccione un área de impresión que comenzando siempre en A1, en algunas ocasiones tenga que seleccionar, por ejemplo, desde A1 hasta I25. ¿Por qué este rango?. Pues porque hay datos hasta la celda A25. Resumiendo que la macro recorra la columna A y cuando encuentre la última celda con datos, cree un rango de impresión desde A1 hasta la columna I que corresponda.

Lo interesante es que conseguiremos esto sin emplear programación en VBA para Excel.. simplemente utilizando la función COINCIDIR e INDIRECTO, así como los nombres definidos.

Partiremos de estos valores de nuestra hoja, viéndolos en Vista Salto de página:

Como era de esperar el Área de impresión se ajusta a los datos de la hoja... (en este caso, incluyendo columnas que no deseamos sean impresas...).

El objetivo es configurar el alto del área de impresión a la última fila con datos de la columna A:A.
Esto lo conseguiremos con la función:
=COINCIDIR(9,9E+307;A:A;1)
lo que nos devolverá siempre el número de la fila última con algún valor numérico!!!.

El truco de emplear esta función COINCIDIR con ese valor 9,9E+307 es por que en Excel, según las especificaciones técnicas, este es el valor más alto posible... por tanto al indicarle el tercer argumento de COINCIDIR con un 1 (menor que), nos devolverá, la última fila con valor númérico.
Otra forma podría ser:
=COINCIDIR(MAX(A:A)+1;A:A;1)
que esencialmente, nos dice lo mismo.
Nos aprovechamos de un 'fallo' en nuestra disposición de datos, ya que el tipo de coincidencia 1 u omitido de la función COINCIDIR encuentra el mayor valor que es menor o igual que el valor_buscado.
Los valores del argumento matriz_buscada deberían estar ordenados en sentido ascendente, en caso contrario 'fallaría' devolviendo el último encontrado...

Podemos trabajar igualmente por columnas, para lo cual bastaría cambiar en nuestra fórmula las referencias de columnas por la de filas.
Por ejemplo,
=COINCIDIR(9,9E+307;1:1;1)
nos dirá cuál es la última columna con valor numérico completado en la fila 1:1.

Una vez tenemos la fila con último dato completado, ya podemos configurar nuestra área de impresión o nuestro rango.
Estableceremos un área de impresión cualquiera, y a continuación accederemos al Administrador de Nombres definidos, donde cambiaremos el campo Se refiere a... por la siguiente fórmula:
=INDIRECTO("Hoja1!$A$1:$I"&COINCIDIR(9,9E+307;Hoja1!$A:$A;1))

Y listo, nuestro área de impresión se ajustará al ancho definido (A:I) y al alto dado por la última celda de la columna A:A con numérico...

Seguir leyendo...

Mapas con Power View de Excel.

Como continuación de la entrada anterior, donde conseguíamos las coordenadas geográficas de diferentes puntos... Hoy representaremos esos datos sobre un mapa incluido en el complemento de Excel Power View (versiones 2013 y +).

Estos son nuestros datos de partida:

Por supuesto, deberemos asegurarnos de tener instalado el complemento Power View.. asi que accederemos a la Ficha Desarrollador > grupo Complementos > botón Complementos COM, y marcaremos el complemento deseado en la ventana mostrada:

Generaremos la hoja de trabajo de Power View... para ello haremos clic en el botón dentro de la Ficha Insertar > grupo Informes > botón Power View:

Esta acción, habiendo seleccionado previamente nuestra Tabla de datos, abrirá nuestra hoja de trabajo 'Power View', mostrándose los datos de la Tabla original de la hoja de cálculo.
Además se habilitará una nueva ficha de Diseño en al cinta de opciones, donde se muestras herramientas de este complemento:

haz clic en la imagen

Con la Tabla en la hoja Power Viwe seleccionada, presionaremos el botón 'Mapa', lo que transformará nuestra tabla en un mapa, con la información representada sobre él.
Deberemos configurar, en el Panel de Campos de Power View, de la siguiente manera:

Es decir, al área de Tamaño llevaremos el campo: Ventas (resumido por suma);
al área de Ubicaciones el campo: Estado (que incluye el código postal y la ciudad);
al área Color el campo Zona (que mostrará cada elemento del campo por un color distinto);
y obviamente los campos Latitud y Longitud a las áreas respectivas...

El resultado final sería el siguiente:

Interesante es mostrar que este complemento nos permite aplicar filtros, como la herramienta 'Autofiltro') sobre los distintos campos...

Por supuesto, la herramienta tiene bastante más recorrido, permitiéndonos conectar información contenida en distintos orígenes, y mostrarla de diferentes formas (gráficos de distintos tipos, tablas segmentadas, ...); todo ello de forma interactiva.

Seguir leyendo...

VBA: Latitud y Longitud de una dirección en Excel.

Hace unas semanas, buscando información sobre coordenadas geográficas de diferentes puntos, me encontré con una función personalizada en VBA (UDF) en la web www.policeanalyst.com que me pareció muy útil...
Por ese motivo me permito subirlo en el blog... con unos mínimos ajustes.

Se trata de una función que recupera los datos de Longitud y Latitud de cualquier dirección desde la herramienta de Google Maps, en su forma decimal.
Lo interesante de este dato es que a partir de la información recuperada, podremos plasmar diferentes datos sobre mapas dentro de nuestro Excel.. empleando herramientas como Power View, Mapas de Bing, etc...

Insertamos el código de la función en un módulo estándar de nuestro proyecto de VBA desde el editor de VB; sin olvidar de agregar la Referencia: Microsoft XML v6.0

Function GoogleGeoCode(address As String, coordenada As String) As Double
'Agregar la Referencia: Microsoft XML v6.0
Dim strAddress As String
Dim strQuery As String
Dim strLatitude As String
Dim strLongitude As String
'Nota: el parámeto 'coordenada' será el texto: 'Latitud' o 'Longitud'

'la función URLEncode transforma la dirección buscada
'en un literal para la búsqueda en Google...
strAddress = URLEncode(address)

'Montamos la cadena de texto par la consulta en el mapa de Google Maps
strQuery = "http://maps.googleapis.com/maps/api/geocode/xml?"
strQuery = strQuery & "address=" & strAddress
strQuery = strQuery & "&sensor=false"

'definimos los componentes XML and HTTP a emplear
Dim googleResult As New MSXML2.DOMDocument
Dim googleService As New MSXML2.XMLHTTP
Dim oNodes As MSXML2.IXMLDOMNodeList
Dim oNode As MSXML2.IXMLDOMNode

'Generamos la consulta en HTTP en la URL de Google...
'asegunrándonos del False para una operación síncrona
googleService.Open "GET", strQuery, False
googleService.send
googleResult.LoadXML (googleService.responseText)

Set oNodes = googleResult.getElementsByTagName("geometry")

'condicionamos la variable 'geometry' obtenida para recuperar
'nuestros parámetros: latitud y longitud
If oNodes.Length = 1 Then
    For Each oNode In oNodes
      strLatitude = oNode.ChildNodes(0).ChildNodes(0).Text
      strLongitude = oNode.ChildNodes(0).ChildNodes(1).Text
      
      If coordenada = "Latitud" Then
        GoogleGeoCode = (Val(Replace(strLatitude, ",", ".")))
      ElseIf coordenada = "Longitud" Then
        GoogleGeoCode = (Val(Replace(strLongitude, ",", ".")))
      End If
    Next oNode
Else
    GoogleGeoCode = Val(0)
End If
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function URLEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String
Dim StringLen As Long: StringLen = Len(StringVal)

If StringLen > 0 Then
ReDim result(StringLen) As String
Dim i As Long, CharCode As Integer
Dim Char As String, Space As String

If SpaceAsPlus Then Space = "+" Else Space = "%20"

For i = 1 To StringLen
  Char = Mid$(StringVal, i, 1)
  CharCode = Asc(Char)

  Select Case CharCode
  Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
    result(i) = Char
  Case 32
    result(i) = Space
  Case 0 To 15
    result(i) = "%0" & Hex(CharCode)
  Case Else
    result(i) = "%" & Hex(CharCode)
  End Select
Next i
URLEncode = Join(result, "")
End If
End Function

El resultado lo podemos ver en la imagen siguiente:

haz clic en la imagen

En el campo Latitud de nuestra Tabla hemos insertado la función:
=GoogleGeocode([@Estado];"Latitud")
y en el campo Longitud:
=GoogleGeocode([@Estado];"Longitud")

Seguir leyendo...

VBA: Retrasando nuestros procedimientos en Excel. Wait, Sleep y Bucles.

Veremos hoy tres trucos para retrasar los procesos de nuestras macros.
En concreto emplearemos una función API (Sleep), un método (Wait) y un bucle (Do..Loop).

Hay que advertir que la forma más exacta es la que resulta de emplear el método .Wait, y que las otras dos formas (bucle y API) son bastante aproximadas.. pero válidas si simplemente queremos dar un intervalo entre partes de nuestros procesos...

Vamos con la primera manera: Empleando bucles para retardar nuestros procedimientos.
Insertamos el código en un módulo estándar de nuestro proyecto de VBA desde el editor de VB.

Sub PasandoElTiempo(contador As Long)
Dim Inicio As Long, Fin As Long

Cuenta = 0
Fin = Cuenta + (contador * 1000)
 
Do Until Inicio >= Fin
    Inicio = Cuenta
    'La función DoEvents entrega la ejecución de la macro para que el sistema operativo pueda procesar otros eventos.
    'además pasa el control de la aplicación para el sistema operativo.
    DoEvents    'evitar siempre que sea posible
    Cuenta = Cuenta + 1
Loop
 
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Pasando()
'Primera parte de nuestro código...
'''''''''''''''''''''''''''''''''''
MsgBox "Hora exacta antes de la espera: " & Format(Time, "hh:mm:ss")

'esperamos durante tres segundos...
'no devuelve una equivalencia lógica 0.001 seg = 1 miliseg !!!
PasandoElTiempo (3)

'Segunda parte de nuestro código...
'''''''''''''''''''''''''''''''''''
MsgBox "Hora exacta tres segundos después: " & Format(Time, "hh:mm:ss")
End Sub

Al lanzar el procedimiento 'Pasando' comprobaremos en el MsgBox de antes y después el tiempo transcurrido... y que es bastante aproximado a los tres segundos perseguidos.

Segunda manera: Empleando la función API Sleep.
Insertamos el código en un módulo estándar de nuestro proyecto de VBA desde el editor de VB.

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)

Sub Durmiendo()
'Primera parte de nuestro código...
'''''''''''''''''''''''''''''''''''
MsgBox "Hora exacta antes de la espera: " & Format(Time, "hh:mm:ss")

'esperamos durante tres segundos...
'no devuelve una equivalencia lógica 0.001 seg = 1 miliseg !!!
Sleep (2000)

'Segunda parte de nuestro código...
'''''''''''''''''''''''''''''''''''
MsgBox "Hora exacta tres segundos después: " & Format(Time, "hh:mm:ss")
End Sub

Fundamental declarar la función Sleep.. ojo!!, valida para versiones de Excel 2010 y +

Tercera manera (la exacta!): Empleando el método .Wait.
Insertamos el código en un módulo estándar de nuestro proyecto de VBA desde el editor de VB.

Sub Esperando()
'Primera parte de nuestro código...
'''''''''''''''''''''''''''''''''''
MsgBox "Hora exacta antes de la espera: " & Format(Time, "hh:mm:ss")

'esperamos durante tres segundos...
Application.Wait (Now + TimeValue("0:00:03"))

'Segunda parte de nuestro código...
'''''''''''''''''''''''''''''''''''
MsgBox "Hora exacta tres segundos después: " & Format(Time, "hh:mm:ss")
End Sub

Esta última es la que nos permite controlar con la máxima exactitud nuestros tiempos de espera o retraso... la más sencilla, y la recomendada por tanto.

Seguir leyendo...

VBA: Importando los contactos de Outlook a Excel.

Seguramente alguna vez has necesitado extraer información de tu Lista de contactos de Outlook, y hayas tenido que recurrir a la exportación en formato .xlsx desde Microsoft Outlook.
Hoy emplearemos una macro para Excel que nos permite importar la información de los contactos desde Excel.

Para ello insertamos nuestro código en un módulo estándar de nuestro proyecto de VBA desde el editor de VB...

Sub Importar_Contactos_Outlook()
'definimos las variables de Outlook como Objects.
Dim olApp As Object
Dim olNamespace As Object
Dim olFolder As Object
Dim olConItems As Object
Dim olItem As Object

'Objetos a usar de nuestro Libro de Excel
Dim wbBook As Workbook
Dim wsSheet As Worksheet
'asignamos valor a los objetos.
Set wbBook = ThisWorkbook           'nuestro libro de trabajo
Set wsSheet = wbBook.Sheets(1)      'la Hoja1 de nuestro libro será el destino de la importación

'Location in the imported contact list.
Dim filaContacto As Long

'Añadimos y formateamos la cabecera de nuestro destino...
With wsSheet
    'primero limpiamos la Hoja destino..
    .Range("A1").CurrentRegion.Clear
    'ahora añadimos la cabecera o rótulos de encabezado...
    .Cells(1, 1).Value = "Nombre de Empresa"
    .Cells(1, 2).Value = "Nombre Completo para mostrar"
    .Cells(1, 3).Value = "Dirección E-mail"
    ' y damos formato....
    With .Range("A1:C1")
        .Font.Bold = True
        .Font.Color = vbRed
        .Font.Size = 11
    End With
End With

wsSheet.Activate

'Configuramos las variables necesarias de Outlook
'empleando el IMAP (=MAPI)
'y la carpeta por defecto de outlook para los contactos...
Set olApp = CreateObject("Outlook.Application")
Set olNamespace = olApp.GetNamespace("MAPI")
Set olFolder = olNamespace.GetDefaultFolder(10)
Set olConItems = olFolder.Items
        
'Número de fila donde comenzamos a traernos los datos importados
filaContacto = 2

'For each contact: if it is a business contact, write out the business info in the Excel worksheet;
'otherwise, write out the personal info.
For Each olItem In olConItems
    If TypeName(olItem) = "ContactItem" Then
        With olItem
                Cells(filaContacto, 1).Value = .CompanyName
                Cells(filaContacto, 2).Value = .FullName
                Cells(filaContacto, 3).Value = .Email1Address
                'otras propiedades de los contactos...:
                '.HomeAddressStreet '.HomeAddressPostalCode '.HomeAddressCity
                '.BusinessAddressCity '.BusinessAddressPostalCode '.BusinessAddressCity
        End With
        'aumentamos la fila
        filaContacto = filaContacto + 1
    End If
Next olItem

'Limpiamos las variables creadas.
Set olItem = Nothing
Set olConItems = Nothing
Set olFolder = Nothing
Set olNamespace = Nothing
Set olApp = Nothing
       
'mensaje de confirmación
MsgBox "Lista importada...!!", vbInformation
    
End Sub

Tras ejecutar veremos en nuestra 'Hoja1' de Libro de trabajo el listado de los contactos de Outlook:

Seguir leyendo...

VBA: Adjuntar hoja activa como pdf al enviar un email desde Excel.

En varias ocasiones me han llegado consultas respecto a la manera de enviar Hojas de nuestros libros de trabajo en Excel como fichero adjunto al enviar nuestros correos...
En principio no es posible tal cosa, ya que Microsoft Outlook sólo permite adjuntar Libros completos... la solución más normal es generar un nuevo Libro y dentro de éste, copiar y pegar la Hoja a enviar.
Hoy haremos una operación algo distinta con una macro.
Generaremos un fichero .pdf temporalmente (luego borraremos como parte del procedimiento) con la hoja activa de nuestro libro, y será este .pdf el que adjuntaremos y enviaremos desde Outlook.

Para ello insertamos el código en un módulo estándar de nuestro proyecto de VBA desde el editor de VB.

Sub EnvioEmail_HojaActiva_comoPDF()
Dim olApp As Object
Dim olMail As Object
Dim RutaTemporal As String, NombreFicheroTemporal  As String, RutaCompleta As String

'deshabilitamos el refresco de pantalla
'y muy importante los eventos!
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

'Definimos una variable que será la Ruta donde guardaremos,
'antes de enviar como adjunto, el pdf que generaremos...
RutaTemporal = Environ$("temp") & "\"

'Generamos el nombre del fichero temporal .Pdf
NombreFicheroTemporal = ActiveSheet.Name & ".pdf"

'Combinando las dos variables anteriores, tendremos la Ruta Completa de nuestro .pdf
RutaCompleta = RutaTemporal & NombreFicheroTemporal

'Depuramos posibles errores a la hora de Exportar
' a la ruta anterior, la hoja activa como PDF
On Error GoTo err
ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=RutaCompleta, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False

'LLega el momento de abrir la aplicación Outlook
Set olApp = CreateObject("Outlook.Application")
'y generar un nuevo email a enviar...
Set olMail = olApp.CreateItem(0)

Dim destinatario As String, Asunto As String, Cuerpo As String
'FALTA ASIGNAR VALORES A ESTAS VARIABLES!!!
On Error Resume Next
With olMail
    .to = destinatario          'añadimos el destinatario, el Para...
    '.CC = destinatario         'para adjuntar destinatario en Con Copia a...
    '.BCC = destinatario        'para adjuntar destinatario en Con Copia Oculta a...
    .Subject = Asunto        'indicaríamos el Asunto
    .Body = Cuerpo           'indicaríamos el Cuerpo del email
    'adjuntamos el fichero pdf desde la ruta donde la guardamos
    .Attachments.Add RutaCompleta
    .Display    'o bien usaremos .Send para enviar directamente...
    '.Send
End With
On Error GoTo 0

'Ya que el email ha sido enviado (o mostrado) con el pdf adjuntado
'podemos borrar el pdf que habíamos guardado (en la carpeta temporal)...
Kill RutaCompleta

'limpiamos las variables creadas.
Set olMail = Nothing
Set olApp = Nothing

'Reestablecemos las condiciones prevías
'refresco de pantalla y activamos loe eventos
With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

Exit Sub

'para el control de errores en caso de exportación como Pdf...
err:
    MsgBox err.Description

End Sub

Si ejecutamos nuestro procedimiento 'EnvioEmail_HojaActiva_comoPDF', veríamos:

Observa que al no haber asignado valor a las variables 'Destinatario, 'Asunto' y 'Cuerpo', en el email no han aparecido completados...

Seguir leyendo...