Visual Basic - Codigo para enviar un email automaticamente

Sub sendmail()

On Error GoTo Eterror:

Dim strPath$, ColAttach  ' , OTLApp, OutlookItem, ColAttach

Dim OTLApp As New Outlook.Application

Dim OutlookItem As Outlook.MailItem

Set OTLApp = CreateObject("Outlook.Application")

Set OutlookItem = OTLApp.CreateItem(olMailItem)

OutlookItem.To = "correo@dominiocom"

OutlookItem.CC = los otros correos

'OutlookItem.BCC = Copia ocula

   'El Asunto del Correo

    OutlookItem.Subject = El correo del & " " & Format(Me.lblfecha.Caption, "YYYYMMDD")

    OutlookItem.Body = texto & vbCr & "Este Correo fue Generado a las " & Format(Time, "HH:MM:SS")

    Set ColAttach = OutlookItem.Attachments

            ColAttach.Add strPath, olByValue, C, "File Attachment"

    ' SI deseo que se muestre DISPLAY, caso contrario directo el SEND

    'OutlookItem.Display

    'OutlookItem.Send    

Eterror:

    'MsgBox Err.Description

End Sub

Sub sendmail()

On Error GoTo Eterror:

Dim strPath$, ColAttach

Dim OTLApp As New Outlook.Application

Dim OutlookItem As Outlook.MailItem

Set temporal = fs.GetFolder(App.Path & "\txt")     'La ruta donde estan los archivos ....

Set OTLApp = CreateObject("Outlook.Application")

Set OutlookItem = OTLApp.CreateItem(olMailItem)

'Rs.Close

OutlookItem.To = "username@dominio.com"

    OutlookItem.Subject = "Titulo del Correo o Subject "

    OutlookItem.Body = "Texto que deseas enviar "

    'Esto es la rutina para adjuntar N Archivos y son los que estanen la ruta de arriba

    Set ColAttach = OutlookItem.Attachments

        C = 1

        For Each Archivo In temporal.Files

            strPath = Archivo

            ColAttach.Add strPath, olByValue, C, "File Attachment"

            C = C + 1

        Next Archivo

    OutlookItem.Display

    OutlookItem.Send

    End If

    'Esta parte es para que ya que las envie las Muevo a otra ruta .. tu podrias solo eliminarlo

    For Each Archivo In temporal.Files

        filename2 = App.Path & "\sent\" & Archivo.Name

        strPath = Archivo

        Set fs = CreateObject("Scripting.FileSystemObject")

        fs.CopyFile Archivo, filename2

        Kill Archivo

    Next Archivo

Eterror:

    'MsgBox Err.Description

    XError = True

End Sub

Sub sendmail()

On Error GoTo Eterror:

Dim strPath$, ColAttach

Dim OTLApp As New Outlook.Application

Dim OutlookItem As Outlook.MailItem

Set temporal = fs.GetFolder(App.Path & "\txt")

Set OTLApp = CreateObject("Outlook.Application")

Set OutlookItem = OTLApp.CreateItem(olMailItem)

OutlookItem.To = "jorge_torres_v2007@hotmail.com"

OutlookItem.Subject = "Sistema Tienda 1"

OutlookItem.Body = "Horario Nocturno"

Set ColAttach = OutlookItem.Attachments

C = 1

For Each Archivo In temporal.Files

    strPath = Archivo

    ColAttach.Add strPath, olByValue, C, "File Attachment"

    C = C + 1

Next Archivo

OutlookItem.Send

Eterror:

    XError = True

End Sub

Private Sub Command1_Click()

sendmail

End Sub