Guardar archivos de Hipervínculo y enviar por correo
Tengo una hoja de Excel con una lista de Hipervínculos y necesito una macro que tome los archivos de los Hipervínculos y los guarde en una carpeta que puede ser cualquiera. Ademas necesito otra macro que pueda tomar el archivo del hipervínculo y enviarlo por correo.
1 respuesta
Para lo primero, si los archivos están alojados en internet, una opción sería utilizar un gestor de descargas como por ejemplo JDownloader, donde simplemente pegas todos los enlaces y te los va descargando a la ubicación que elijas.
Lo segundo es más sencillo:
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olFormatplain)
On Error Resume Next
With OutMail
.SentOnBehalfOfName = "[email protected]" ‘AQUÍ VA LA DIRECCIÓN DESDE LA QUE QUIERES ENVIAR EL MAIL. Puedes eliminar esta línea y el correo se enviará desde tu cuenta predeterminada.
.To = "[email protected]; [email protected]" ‘DESTINATARIOS DEL MAIL, SEPARA LAS DIRECCIÓN CON PUNTO Y COMA
.CC = "[email protected]; [email protected]" ‘DESTINATARIOS EN COPIA
.BCC = "[email protected]; [email protected]" ‘DESTINATARIOS EN COPIA OCULTA
.objMail.BodyFormat = olFormatplain
.BodyFormat = olFormatplain
.Msg.BodyFormat = 1
.Subject = "Asunto del correo" ‘ASUNTO DEL MAIL
. Body = "Cuerpo del mensaje” ‘AQUÍ ES DONDE DEBERÍAS PONER LOS ENLACES. HAZ MENCIÓN A LAS CELDAS DONDE ESTÉN DICHOS ENLACES MEDIANTE Range(“celda”).Value
. Attachments. Add ActiveWorkbook. Fullname ‘este comando adjunta al mail el libro actualmente activo. Se puede omitir esto.
. Display 'display te mostrará el correo, pero si lo cambias a send se enviará automáticamente
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Experto. gracias por tu respuesta, pero aun tengo una duda...
Los archivos están alojados en mi PC en una única carpeta. Lo que necesito es que me de la opción de guardarlos en diferentes carpetas pero en una misma ubicación.
Pd: El envío del correo funciona perfecto.
Prueba con este código, sirve para copiar archivos de una ubicación a otra. Pero ten en cuenta que el directorio de destino debe estar creado previamente:
Sub CopiarArchivos()
'
'Esta macro sirve para copiar archivos de una ubicación a otra. La ubicación de destino debe estar creada previamente.
Dim oFSO
Dim sSourceFile
Dim sDestinationFile
Set oFSO = CreateObject("Scripting.FileSystemObject")
sSourceFile = "C:\Documents\Escritorio\CARPETA_A\ARCHIVO1.txt" 'Ubicación origen
sDestinationFile = "C:\Documents\Escritorio\CARPETA_B\ARCHIVO2.txt" 'Ubicación destino
oFSO.CopyFile sSourceFile, sDestinationFile
Set oFSO = Nothing
End Sub
