Saltar al contenido

VBScript – Adjuntar archivos automáticamente y enviar correo Outlook

Valora la información: 1 estrella2 estrellas3 estrellas4 estrellas5 estrellas (Ninguna valoración todavía)
VBScript - Adjuntar archivos automáticamente y enviar correo Outlook 1Cargando…

La función del siguiente VBScript es adjuntar un archivo o archivos automáticamente en base a la búsqueda de una serie de dígitos en el nombre del archivo y enviarlos por correo electrónico.

Instrucciones de Uso

1.- Abrir el editor de Visual Basic (ALT+F11).

2.- Insertar un modulo nuevo (Insert > Module).

3.- Copiar el código VBScript.

4.- Realizamos las modificaciones necesarias tal como ruta donde se guardan los archivos, las lineas que modificaremos son las: 17, 35 a la 39.

5.- Ejecutamos con la tecla F5

6.- Cuando lo ejecutemos nos mostrara una ventana donde capturamos el dato a buscar (Detecta mayúsculas y minúsculas).VBScript - Adjuntar archivos automáticamente y enviar correo Outlook 2

6.- Una vez que demos OK para la búsqueda, nos abrirá un correo con los adjuntos encontrados y el cuerpo de correo que hayamos especificado.VBScript - Adjuntar archivos automáticamente y enviar correo Outlook 3

Otro ejemplo donde se adjuntan todos los archivos que contienen el numero 347.

VBScript - Adjuntar archivos automáticamente y enviar correo Outlook 4

7.- Podemos enviar después de revisar el correo, si deseamos que se envíe automáticamente se pusieron comentarios en las lineas 38 y 39 del código.

Para mas información de configuración ver: Como utilizar el Editor VBA en Office (Utilizar Macros VBScript) y Outlook – Crear y configurar reglas

Código

Sub AttachFilesbyEmailAutomatically()

Dim fldName As String
Dim fName As String
Dim sAttName As String
Dim strName As String

Dim olApp As Outlook.Application
Dim olMsg As Outlook.MailItem
Dim olAtt As Outlook.Attachments
 
Set olApp = Outlook.Application
Set olMsg = olApp.CreateItem(0)
Set olAtt = olMsg.Attachments

'Ruta donde se guardan los archivos
fldName = "C:\1-Tests\"

fName = dir(fldName)

strName = InputBox("Digito contenido")

 Do While Len(fName) > 0
  
  If InStr(fName, strName) > 0 Then
    olAtt.Add fldName & fName
    sAttName = fName & "-" & sAttName
   End If
   fName = dir
Loop

 
' send message
With olMsg
  .Subject = "Se adjuntan archivos solicitados"
  .To = "[email protected]"
  .HTMLBody = "Buen dia! " & olMsg.To & ",  Se adjuntan los archivos: " & sAttName & " en base a lo solicitado."
  .Display ' Marcar como comentario para envio automatico
  '.Send ' Desmarcar para envio automatico
End With
 

End Sub

Código basado en codigo de Diane Poremsky y modificado a solicitud de morpvin.

Leer entrada anterior
Windows 10 - El explorador de archivos carga lento los archivos de la carpeta 15
Windows 10 – El explorador de archivos carga lento los archivos de la carpeta

Windows 10 ha presentado algunos errores desde su lanzamiento el cual muchos de estos no se conoce el motivo por el...

Cerrar