Descargar archivos de Google Drive a través de macros

Hoy en día en que definitivamente cada vez está más en apogeo el uso de internet, se hace cada vez más masivo el uso de la nube para compartir archivos. Creo yo, casi sin duda, que es probable que Google Drive sea uno de los servicios de alojamiento más usado hoy en día y es por eso que justamente en esta oportunidad veremos algo al respecto.

A veces queremos compartir archivos a través de Google Drive, pero queremos que las demás personas los descarguen, no que necesariamente los vean en línea. Claro, para eso bastaría abrir el archivo en línea y luego usar el menú de descargar, pero podríamos hacer eso de forma automática y directa usando macros desde Excel ¿Cómo? Vamos a ello.

Lo primero es colocar un archivo en Google Drive; yo usaré uno de Excel.

Luego habiliten la opción para compartir (es lo mismo si como editor o lector). El enlace debería ser algo así:

https://docs.google.com/spreadsheets/d/1QhRDyGzLVXpx3mJeZz3_AyGs9eMQZVI8/edit?usp=sharing&ouid=111234567836533797192&rtpof=true&sd=true

La parte que nos interesa es la siguiente:

1QhRDyGzLVXpx3mJeZz3_AyGs9eMQZV

Extraer la cadena que necesitamos no es tan complicado, dado que siempre está antes del último slash del enlace con el cual se comparte el archivo. Para ello podemos hacer lo siguiente, suponiendo que mediante un InputBox ingresamos dicho enlace, y utilizando una matriz en la cual tomemos en cuenta justamente la posición de ese último slash.

Dim iniEnlace$, Cadena$ 
Dim nMatriz As Integer 
Dim mCadenas() As String 

iniEnlace = InputBox("Ingrese el enlace de Google Drive:", "Descarga desde Google Drive - Todo Sobre Excel") 
'Del siguiente modo obtenemos cuántos slash hay en el enlace; como sabemos que el que interesa es el último 
'al tener la cantidad de ellos, nos ayudará a saber la posición de la cadena cuando usemos el enlace como matriz 
nMatriz = Len(iniEnlace) - Len(Application.WorksheetFunction.Substitute(iniEnlace, "/", "")) 
'con split dividimos el enlace como matriz para tener todo separado basado en los slash y obtendrmeos la cadena de nuestro interés 
mCadenas = Split(iniEnlace, "/") Cadena = mCadenas(nMatriz - 1) 

De ese modo en la variable cadena ya tenemos solo lo siguiente:

1QhRDyGzLVXpx3mJeZz3_AyGs9eMQZVI8

Luego, para la descarga final necesitamos generar un enlace de este tipo:

https://drive.google.com/uc?id=1HuDhIYFLvLoDme79gjrwL0QxvPXYzoH5&export=download&authuser=0

Lo que está después del “uc?id=” y antes de la parte que dice “&export” ,es en donde irá la cadena que hemos conseguido previamente. Podemos hacerlo así:

Dim Enlacefinal$ 

Enlacefinal = “https://drive.google.com/uc?id=” & Cadena  & “&export=download&authuser=0” 

Ahora lo que nos falta es la descarga propiamente dicha. Para ello usaremos una función de la API de Windows: URLDownloadToFile (Enlace). Lo primero es declararla para su uso en Excel de 32 bits y de 64 bits.

#If VBA7 Then
    Public Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _       
	 Alias "URLDownloadToFileA" ( _         
	  ByVal pCaller As LongPtr, _         
	  ByVal szURL As String, _         
	  ByVal szFileName As String, _         
	  ByVal dwReserved As LongPtr, _         
	  ByVal lpfnCB As LongPtr _       
	 ) As Long 
	 
#Else     

    Public Declare Function URLDownloadToFile Lib "urlmon" _       
     Alias "URLDownloadToFileA" ( _         
	 ByVal pCaller As Long, _         
	 ByVal szURL As String, _         
	 ByVal szFileName As String, _         
	 ByVal dwReserved As Long, _         
	 ByVal lpfnCB As Long _       
    ) As Long 
#End If 

Si aquellos/as que tienen Excel de 64 bits ven parte de las letras en rojo, tranquilos, no pasará nada malo.

Y ahora sí, para la descarga usaremos esto:

URLDownloadToFile 0, enlacefinal, "D:\archivodescargado.xlsx", 0, 0

Ojo, obvio ahí uso para el archivo descargado uno del tipo xlsx (que debería coincidir con el que se descargó), pero podría usarse para cualquier tipo de archivo que está en Google Drive y hasta podría usarse una ventana de diálogo para la ruta y tipo de archivo final, pero esa es tarea para ustedes.

Todo se vería así:

Option Explicit 
'Todo Sobre Excel 
'Abraham Valencia 
'https://abrahamexcel.blogspot.com/ 
'https://www.facebook.com/TodosobreExcelAV/ 
'https://twitter.com/Todosobre_Excel 
'https://www.youtube.com/channel/UCxEe3aA5uGrtYDdboBT_ptg 
'Lima, Perú 
'Enero del 2022   

#If VBA7 Then
    Public Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _       
	 Alias "URLDownloadToFileA" ( _         
	  ByVal pCaller As LongPtr, _         
	  ByVal szURL As String, _         
	  ByVal szFileName As String, _         
	  ByVal dwReserved As LongPtr, _         
	  ByVal lpfnCB As LongPtr _       
	 ) As Long 
	 
#Else     

    Public Declare Function URLDownloadToFile Lib "urlmon" _       
     Alias "URLDownloadToFileA" ( _         
	 ByVal pCaller As Long, _         
	 ByVal szURL As String, _         
	 ByVal szFileName As String, _         
	 ByVal dwReserved As Long, _         
	 ByVal lpfnCB As Long _       
    ) As Long 
#End If 

Sub DescargarArchivos() 

Dim iniEnlace$, Cadena$, Enlacefinal$ 
Dim nMatriz As Integer Dim mCadenas() As String 

iniEnlace = InputBox("Ingrese el enlace de Google Drive:", "Descarga desde Google Drive - Todo Sobre Excel") 

If iniEnlace = Empty Then      
	MsgBox "Usted no escribió nada o canceló", vbOKOnly, "Todo Sobre Excel"     
	Exit Sub 
End If 

'Del siguiente modo obtenemos cuántos slash hay en el enlace; como sabemos que el que interesa es el último 
'al tener la cantidad de ellos, nos ayudará a saber la posición de la cadena cuando usameo el enlace como matriz 
nMatriz = Len(iniEnlace) - Len(Application.WorksheetFunction.Substitute(iniEnlace, "/", "")) 
'con split dividimos el enlace como matriz para tener todo separado basado en los slash y obtendremos la cadena de nuestro interés 
mCadenas = Split(iniEnlace, "/") 
'Elegimos el valor de la matriz en donde sabemos está la cadena que nos interesa 
Cadena = mCadenas(nMatriz - 1) 

Enlacefinal = "https://drive.google.com/uc?id=" & Cadena & "&export=download&authuser=0" 

URLDownloadToFile 0, Enlacefinal, "D:\archivodescargado.xlsx", 0, 0 

MsgBox "Archivo descargado", vbOKOnly, "Todo Sobre Excel" End Sub 

End Sub 

Y listo, eso es todo por hoy. Espero les sea útil. ¡Hasta la próxima!

Abraham Valencia
Lima, Perú

Descargue el archivo aquí: Enlace

Microsoft Outlook desde Excel (V): Imagen en el cuerpo del mensaje (Sin errores)

Durante muchos años en internet se han publicado un sinfín de artículos sobre el envío de correo electrónico a través del VBA de Excel. Yo mismo he publicado varias cosas al respecto haciendo uso de Microsoft Outlook o, mejor dicho, a través del objeto Outlook.

En el sentido de lo mencionado en el párrafo anterior, una de las preguntas recurrentes sobre el tema es sobre cómo dar formato a los textos enviados a través del VBA y el mensaje de correo electrónico, sobre todo incluyendo imágenes en el cuerpo del mensaje y/o como firma. Si bien la respuesta inmediata, y que se puede también encontrar en diversas páginas de internet, es usar la propiedad “HTMLBody” y aplicar algo de HTML (Enlace), aunque a muchas personas les ocurre de manera recurrente que la imagen puede hasta llegar como archivo adjunto, pero no se ve en el cuerpo del mensaje o se ve como un marco vacío (no he encontrado personas que les ocurra si se usa en el cuerpo del mensaje una imagen que ya está guardada en alguna url de internet), sobre todo cuando envían a Gmail o Hotmail y más con las nuevas versiones de Office, Windows y los nuevos niveles de seguridad de los servidores.

Buscando, leyendo, indagando, etc., hace un tiempo encontré una solución al dilema mencionado, usando algunas propiedades del objeto Outlook y accediendo a propiedades de la interfaz de programación de aplicaciones de mensajería del servidor a través de los conocidos Schema de Microsoft, lo que hoy compartiré con todos/as.

Comenzaremos declarando cinco variables que son las que vamos a usar; la primera estoy seguro que ya es conocida por ustedes.

Dim outlookApp As Outlook.Application

Luego las siguientes, que dejaré comentadas para que sepan a que nos ayuda cada una:

‘Objeto mensaje de correo 
Dim mCorreo As MailItem   
‘Colección de objetos Attachment 
Dim colecAttach As Outlook.Attachments 
‘Objeto Attachment, que representa lo que vamos a adjuntar 
Dim objAttach As Outlook.Attachment 
‘Permite crear, obtener, establecer y eliminar propiedades en el objeto Outlook 
Dim proOutlook As Outlook.PropertyAccessor 
Dim Ruta$, nImagen$ 

Ahora, vamos a declarar una constante que es equivalente a una de las propiedades canónicas PidTagAttachContentId. Esta contiene el encabezado de identificación de un archivo adjunto de mensaje de extensiones multipropósito de correo de Internet. Vamos a darle el valor de un Schema de Microsoft (Data and Story Library – DASL).

Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"

Luego daremos valores a las variables:

'Creamos el objeto Outlook 
Set outlookApp = CreateObject("Outlook.Application") 
'Creamos el mensaje 
Set mCorreo = outlookApp.CreateItem(olMailItem) 
'Creamos el adjunto en el mensaje 
Set colecAttach = mCorreo.Attachments 
'Adjuntamos el archivo/Imagen 
Set objAttach = colecAttach.Add("C:\Users\eavj6\Pictures\pez.jpg") 
'Indicamos que haremos uso de una propiedad del adjunto 
Set proOutlook = objAttach.PropertyAccessor 
Ruta = "C:\Users\eavj6\Pictures\" 
nImagen = "pez.jpg" 

Lo que toca ahora es usar el método SetProperty para el nombre del Schema y el valor que nos interesa..

proOutlook.SetProperty PR_ATTACH_CONTENT_ID, "pez.jpg"

Lo que sigue debería entenderse si leyeron mis artículos anteriores jejeje.

With mCorreo
   .Close olSave     
	 .HTMLBody = "<BODY><IMG src=""cid:pez.jpg""> </BODY>" ‘aquí insertamos la imagen adjunta en el cuerpo del mensaje     
	 .Save     
	 .To = "uncorreo@gmail.com"     
	 .Subject = "Prueba"     
	 .Send
End With 

Todo junto podría quedar del siguiente modo:

Option Explicit 
'Todo Sobre Excel 
'Abraham Valencia 
'https://abrahamexcel.blogspot.com/ 
'https://www.facebook.com/TodosobreExcelAV/ 
'https://twitter.com/Todosobre_Excel 
'https://www.youtube.com/channel/UCxEe3aA5uGrtYDdboBT_ptg 
'Lima, Perú 
'Enero del 2022   

Sub ImagenenCuerpo() 

Dim outlookApp As Outlook.Application 
'Objeto mensaje de correo 
Dim mCorreo As MailItem 
'Colección de objetos Attachment 
Dim colecAttach As Outlook.Attachments 
'Objeto Attachment, que representa lo que vamos a adjuntar 
Dim objAttach As Outlook.Attachment 
'Permite crear, obtener, establecer y eliminar propiedades en el objeto Outlook 
Dim proOutlook As Outlook.PropertyAccessor 
Dim Ruta$, nImagen$ 

Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001F" 

'Creamos el objeto Outlook 
Set outlookApp = CreateObject("Outlook.Application") 
'Creamos el mensaje 
Set mCorreo = outlookApp.CreateItem(olMailItem) 
'Creamos el adjunto en el mensaje 
Set colecAttach = mCorreo.Attachments 
'Adjuntamos el archivo/Imagen 
Set objAttach = colecAttach.Add("C:\Users\eavj6\Pictures\pez.jpg") 
'Indicamos que haremos uso de una propiedad del adjunto 
Set proOutlook = objAttach.PropertyAccessor 
Ruta = "C:\Users\eavj6\Pictures\" 
nImagen = "pez.jpg" 

proOutlook.SetProperty PR_ATTACH_CONTENT_ID, "pez.jpg" 

With mCorreo     
   .Close olSave     
   .HTMLBody = "<BODY><IMG src=""cid:pez.jpg""> </BODY>" 'aquí insertamos la imagen adjunta en el cuerpo del mensaje     
   .Save     
   .To = "uncorreo@gmail.com@gmail.com"     
   .Subject = "Prueba"     
   .Send 
End With      

MsgBox "Mensaje enviado", vbOKOnly, "Todo Sobre Excel" 

End Subb 

Y listo, eso es todo por hoy. Espero les sea útil. ¡Hasta la próxima!

Abraham Valencia
Lima, Perú