asked on

Adding Attachments to Outlook Email via Script

Good Morning,

I want to be able to attach all PDF's that are located in a folder to an email.

I was going to use something like this

.AddAttachment "D:\folder\*.pdf"

Any ideas/

Kimputer

No, you have to use a for each loop where the system enumerates the files, ex:

For Each oFile In oFSO.GetFolder(sFolder).Files
.AddAttachment oFile
Next

NICK COLLINS

ASKER

Following from my request - Here is the code that was provided for a previous task

I want to be able to add attach a folder of PDF documents to the email but the path contains current date

C:\test\yyyymmdd\

' Constants text-align: centre
Const cSmtpUser = "USer"                                ' *** MAKE CHANGES HERE ***
Const cSmtpPassword = "Password"                            ' *** MAKE CHANGES HERE ***
Const cSmtpServer = "Server"                          ' *** MAKE CHANGES HERE ***
Const cSmtpPort = 25                                       ' *** MAKE CHANGES HERE *** (25, 465, 587 common)
Const cFromEmail = "test@test.org.uk"                      ' *** MAKE CHANGES HERE ***
Const cToEmail = "dummy@test.org.uk"                        ' *** MAKE CHANGES HERE ***
Const cSubject = "**** Report Completed ****"                     ' *** MAKE CHANGES HERE ***

' CDO Constants needed to send email
Const cCdoSendUsingPickup = 1   'Send message using the local SMTP service pickup directory.
Const cCdoSendUsingPort = 2     'Send the message using the network (SMTP over the network).
Const cCdoAnonymous = 0         'Do not authenticate
Const cCdoBasic = 1             'basic (clear-text) authentication
Const cCdoNTLM = 2              'NTLM
Const cCdoSendUsingMethod        = "http://schemas.microsoft.com/cdo/configuration/sendusing"
Const cCdoSMTPServer             = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Const cCdoSMTPServerPort         = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Const cCdoSMTPConnectionTimeout  = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
Const cCdoSMTPAuthenticate       = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
Const cCdoSendUserName           = "http://schemas.microsoft.com/cdo/configuration/sendusername"
Const cCdoSendPassword           = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
Const cCdoSmtpUseSsl             = "http://schemas.microsoft.com/cdo/configuration/smtpusessl"

' Text file I/O constants
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const TristateTrue = -1
Const TristateFalse = 0
Const TristateUseDefault = -2

' Location of CSV data file
strDataFile = "C:\Test\Output\Report.txt"

' Create filesystem object
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Load CSV data file
With objFSO.OpenTextFile(strDataFile, ForReading, False, TriStateUseDefault)
    arrData = Split(.ReadAll, vbCrLf)
    .Close
End With

' Build headers in HTML report and CSV file
strHTML = "<HTML>"
strHTML = strHTML & "<BODY>"
strHTML = strHTML & "<P>**** Completed Certificates****<P>"
strHTML = strHTML & "<TABLE style=""color: black; font-family: Arial; font-size: 12; border-collapse:collapse; text-align: centre;"" border=""1"" cellpadding=""7"" cellspacing=""15"" summary="""">"

' Set up HTML table header
strHTML = strHTML & "<THEAD style=""color: blue; background-color:rgb(180, 180, 180)"">"
strHTML = strHTML & "<TR>"
strHTML = strHTML & "<TH>" & "  Date & Time Completed  " & "</TH>" & "<TH>" & "  Description  " & "</TH>" & "<TH>" & "  Completed By  " & "</TH>" & "<TH>" & "  Number  " & "</TH>" & "<TH>" & "  Site  " & "</TH>" & "<TH>" & "  Type   " & "</TH>"
strHTML = strHTML & "</TR>"
strHTML = strHTML & "</THEAD>"

' Set up HTML table data
strHTML = strHTML & "<TBODY>"

' Process each line of data
For i = 1 To UBound(arrData)

    ' Skip any blank lines in file
    If Trim(arrData(i)) <> "" Then

        ' Parse line into individual fields
        arrFields = Split(Replace(arrData(i), """", ""), ",")

        ' Make sure the correct number of columns were found (exactly!)
        If UBound(arrFields) = 5 Then
            ' Add to table
            strHTML = strHTML & "<TR>"
            For j = 0 To UBound(arrFields)
                strHTML = strHTML & "<TD>" & arrFields(j) & "</TD>"
            Next
            strHTML = strHTML & "</TR>"
        End If

    End If

Next

' Wrap up HTML table format
strHTML = strHTML & "</TR>"
strHTML = strHTML & "</TBODY>"

' Wrap up HTML format
strHTML = strHTML & "</TABLE>"
strHTML = strHTML & "</BODY>"
strHTML = strHTML & "</HTML>"


' Get a handle to the config object and it's fields
Set objConfig = CreateObject("CDO.Configuration")

' Set config fields we care about
With objConfig.Fields
    .Item(cCdoSendUsingMethod)       = cCdoSendUsingPort
    .Item(cCdoSMTPServer)            = cSmtpServer
    .Item(cCdoSMTPServerPort)        = cSmtpPort
    .Item(cCdoSMTPConnectionTimeout) = 60
    .Item(cCdoSMTPAuthenticate)      = cCdoBasic
    .Item(cCdoSendUserName)          = cSmtpUser
    .Item(cCdoSendPassword)          = cSmtpPassword
    .Item(cCdoSmtpUseSsl)            = True
    .Update
End With

' Create a new message
Set objMessage = CreateObject("CDO.Message")
Set objMessage.Configuration = objConfig

' Populate message fields and send it
With objMessage
    .To       = cToEmail
    .From     = cFromEmail
    .Subject  = cSubject
    .HtmlBody = strHTML
    .AddAttachment strDataFile
    .Send
End With

Open in new window

Kimputer

' Constants text-align: centre
Const cSmtpUser = "USer"                                ' *** MAKE CHANGES HERE ***
Const cSmtpPassword = "Password"                            ' *** MAKE CHANGES HERE ***
Const cSmtpServer = "Server"                          ' *** MAKE CHANGES HERE ***
Const cSmtpPort = 25                                       ' *** MAKE CHANGES HERE *** (25, 465, 587 common)
Const cFromEmail = "test@test.org.uk"                      ' *** MAKE CHANGES HERE ***
Const cToEmail = "dummy@test.org.uk"                        ' *** MAKE CHANGES HERE ***
Const cSubject = "**** Report Completed ****"                     ' *** MAKE CHANGES HERE ***

' CDO Constants needed to send email
Const cCdoSendUsingPickup = 1   'Send message using the local SMTP service pickup directory.
Const cCdoSendUsingPort = 2     'Send the message using the network (SMTP over the network).
Const cCdoAnonymous = 0         'Do not authenticate
Const cCdoBasic = 1             'basic (clear-text) authentication
Const cCdoNTLM = 2              'NTLM
Const cCdoSendUsingMethod        = "http://schemas.microsoft.com/cdo/configuration/sendusing"
Const cCdoSMTPServer             = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Const cCdoSMTPServerPort         = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Const cCdoSMTPConnectionTimeout  = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
Const cCdoSMTPAuthenticate       = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
Const cCdoSendUserName           = "http://schemas.microsoft.com/cdo/configuration/sendusername"
Const cCdoSendPassword           = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
Const cCdoSmtpUseSsl             = "http://schemas.microsoft.com/cdo/configuration/smtpusessl"

' Text file I/O constants
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const TristateTrue = -1
Const TristateFalse = 0
Const TristateUseDefault = -2

' Location of CSV data file
strDataFile = "C:\Test\Output\Report.txt"

' Create filesystem object
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Load CSV data file
With objFSO.OpenTextFile(strDataFile, ForReading, False, TriStateUseDefault)
    arrData = Split(.ReadAll, vbCrLf)
    .Close
End With

' Build headers in HTML report and CSV file
strHTML = "<HTML>"
strHTML = strHTML & "<BODY>"
strHTML = strHTML & "<P>**** Completed Certificates****<P>"
strHTML = strHTML & "<TABLE style=""color: black; font-family: Arial; font-size: 12; border-collapse:collapse; text-align: centre;"" border=""1"" cellpadding=""7"" cellspacing=""15"" summary="""">"

' Set up HTML table header
strHTML = strHTML & "<THEAD style=""color: blue; background-color:rgb(180, 180, 180)"">"
strHTML = strHTML & "<TR>"
strHTML = strHTML & "<TH>" & "  Date & Time Completed  " & "</TH>" & "<TH>" & "  Description  " & "</TH>" & "<TH>" & "  Completed By  " & "</TH>" & "<TH>" & "  Number  " & "</TH>" & "<TH>" & "  Site  " & "</TH>" & "<TH>" & "  Type   " & "</TH>"
strHTML = strHTML & "</TR>"
strHTML = strHTML & "</THEAD>"

' Set up HTML table data
strHTML = strHTML & "<TBODY>"

' Process each line of data
For i = 1 To UBound(arrData)

    ' Skip any blank lines in file
    If Trim(arrData(i)) <> "" Then

        ' Parse line into individual fields
        arrFields = Split(Replace(arrData(i), """", ""), ",")

        ' Make sure the correct number of columns were found (exactly!)
        If UBound(arrFields) = 5 Then
            ' Add to table
            strHTML = strHTML & "<TR>"
            For j = 0 To UBound(arrFields)
                strHTML = strHTML & "<TD>" & arrFields(j) & "</TD>"
            Next
            strHTML = strHTML & "</TR>"
        End If

    End If

Next

' Wrap up HTML table format
strHTML = strHTML & "</TR>"
strHTML = strHTML & "</TBODY>"

' Wrap up HTML format
strHTML = strHTML & "</TABLE>"
strHTML = strHTML & "</BODY>"
strHTML = strHTML & "</HTML>"


' Get a handle to the config object and it's fields
Set objConfig = CreateObject("CDO.Configuration")

' Set config fields we care about
With objConfig.Fields
    .Item(cCdoSendUsingMethod)       = cCdoSendUsingPort
    .Item(cCdoSMTPServer)            = cSmtpServer
    .Item(cCdoSMTPServerPort)        = cSmtpPort
    .Item(cCdoSMTPConnectionTimeout) = 60
    .Item(cCdoSMTPAuthenticate)      = cCdoBasic
    .Item(cCdoSendUserName)          = cSmtpUser
    .Item(cCdoSendPassword)          = cSmtpPassword
    .Item(cCdoSmtpUseSsl)            = True
    .Update
End With

' Create a new message
Set objMessage = CreateObject("CDO.Message")
Set objMessage.Configuration = objConfig

' Populate message fields and send it
With objMessage
    .To       = cToEmail
    .From     = cFromEmail
    .Subject  = cSubject
    .HtmlBody = strHTML
	
'NEW CODE INSERT START 1
sFolder = "C:\test\" &  date_stamp() & "\"
For Each oFile In objFSO.GetFolder(sFolder).Files
  .AddAttachment oFile
Next


'NEW CODE INSERT END 1
    
    .Send
End With

'NEW CODE INSERT START 2
function date_stamp()
	date_stamp = cstr(year(now)) +  leadingzero(month(now)) +  leadingzero(day(now))
end function


function leadingzero(input)
	leadingzero = right("0" + cstr(input),2)
end function
'NEW CODE INSERT END 2

Open in new window

NICK COLLINS

ASKER

Thank you..

When attaching the PDF documents.. is it possible to add PDF documents where the filename begins with HV.

Kimputer

' Constants text-align: centre
Const cSmtpUser = "USer"                                ' *** MAKE CHANGES HERE ***
Const cSmtpPassword = "Password"                            ' *** MAKE CHANGES HERE ***
Const cSmtpServer = "Server"                          ' *** MAKE CHANGES HERE ***
Const cSmtpPort = 25                                       ' *** MAKE CHANGES HERE *** (25, 465, 587 common)
Const cFromEmail = "test@test.org.uk"                      ' *** MAKE CHANGES HERE ***
Const cToEmail = "dummy@test.org.uk"                        ' *** MAKE CHANGES HERE ***
Const cSubject = "**** Report Completed ****"                     ' *** MAKE CHANGES HERE ***

' CDO Constants needed to send email
Const cCdoSendUsingPickup = 1   'Send message using the local SMTP service pickup directory.
Const cCdoSendUsingPort = 2     'Send the message using the network (SMTP over the network).
Const cCdoAnonymous = 0         'Do not authenticate
Const cCdoBasic = 1             'basic (clear-text) authentication
Const cCdoNTLM = 2              'NTLM
Const cCdoSendUsingMethod        = "http://schemas.microsoft.com/cdo/configuration/sendusing"
Const cCdoSMTPServer             = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Const cCdoSMTPServerPort         = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Const cCdoSMTPConnectionTimeout  = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
Const cCdoSMTPAuthenticate       = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
Const cCdoSendUserName           = "http://schemas.microsoft.com/cdo/configuration/sendusername"
Const cCdoSendPassword           = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
Const cCdoSmtpUseSsl             = "http://schemas.microsoft.com/cdo/configuration/smtpusessl"

' Text file I/O constants
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const TristateTrue = -1
Const TristateFalse = 0
Const TristateUseDefault = -2

' Location of CSV data file
strDataFile = "C:\Test\Output\Report.txt"

' Create filesystem object
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Load CSV data file
With objFSO.OpenTextFile(strDataFile, ForReading, False, TriStateUseDefault)
    arrData = Split(.ReadAll, vbCrLf)
    .Close
End With

' Build headers in HTML report and CSV file
strHTML = "<HTML>"
strHTML = strHTML & "<BODY>"
strHTML = strHTML & "<P>**** Completed Certificates****<P>"
strHTML = strHTML & "<TABLE style=""color: black; font-family: Arial; font-size: 12; border-collapse:collapse; text-align: centre;"" border=""1"" cellpadding=""7"" cellspacing=""15"" summary="""">"

' Set up HTML table header
strHTML = strHTML & "<THEAD style=""color: blue; background-color:rgb(180, 180, 180)"">"
strHTML = strHTML & "<TR>"
strHTML = strHTML & "<TH>" & "  Date & Time Completed  " & "</TH>" & "<TH>" & "  Description  " & "</TH>" & "<TH>" & "  Completed By  " & "</TH>" & "<TH>" & "  Number  " & "</TH>" & "<TH>" & "  Site  " & "</TH>" & "<TH>" & "  Type   " & "</TH>"
strHTML = strHTML & "</TR>"
strHTML = strHTML & "</THEAD>"

' Set up HTML table data
strHTML = strHTML & "<TBODY>"

' Process each line of data
For i = 1 To UBound(arrData)

    ' Skip any blank lines in file
    If Trim(arrData(i)) <> "" Then

        ' Parse line into individual fields
        arrFields = Split(Replace(arrData(i), """", ""), ",")

        ' Make sure the correct number of columns were found (exactly!)
        If UBound(arrFields) = 5 Then
            ' Add to table
            strHTML = strHTML & "<TR>"
            For j = 0 To UBound(arrFields)
                strHTML = strHTML & "<TD>" & arrFields(j) & "</TD>"
            Next
            strHTML = strHTML & "</TR>"
        End If

    End If

Next

' Wrap up HTML table format
strHTML = strHTML & "</TR>"
strHTML = strHTML & "</TBODY>"

' Wrap up HTML format
strHTML = strHTML & "</TABLE>"
strHTML = strHTML & "</BODY>"
strHTML = strHTML & "</HTML>"


' Get a handle to the config object and it's fields
Set objConfig = CreateObject("CDO.Configuration")

' Set config fields we care about
With objConfig.Fields
    .Item(cCdoSendUsingMethod)       = cCdoSendUsingPort
    .Item(cCdoSMTPServer)            = cSmtpServer
    .Item(cCdoSMTPServerPort)        = cSmtpPort
    .Item(cCdoSMTPConnectionTimeout) = 60
    .Item(cCdoSMTPAuthenticate)      = cCdoBasic
    .Item(cCdoSendUserName)          = cSmtpUser
    .Item(cCdoSendPassword)          = cSmtpPassword
    .Item(cCdoSmtpUseSsl)            = True
    .Update
End With

' Create a new message
Set objMessage = CreateObject("CDO.Message")
Set objMessage.Configuration = objConfig

' Populate message fields and send it
With objMessage
    .To       = cToEmail
    .From     = cFromEmail
    .Subject  = cSubject
    .HtmlBody = strHTML
	
'NEW CODE INSERT START 1
sFolder = "C:\test\" &  date_stamp() & "\"
For Each oFile In objFSO.GetFolder(sFolder).Files
	if (Left(LCase(oFile), 2) = "hv") and (Right(LCase(oFile), 4) = ".pdf") then
		.AddAttachment oFile
	end if 
Next


'NEW CODE INSERT END 1
    
    .Send
End With

'NEW CODE INSERT START 2
function date_stamp()
	date_stamp = cstr(year(now)) +  leadingzero(month(now)) +  leadingzero(day(now))
end function


function leadingzero(input)
	leadingzero = right("0" + cstr(input),2)
end function
'NEW CODE INSERT END 2

Open in new window

NICK COLLINS

ASKER

Just running some test but it isn't attaching the files beginning with 'HV'

I have some attached a image of the files - I'm only interested in 'HV'

Kimputer

Did you check if the folder is still correct?
You can try to debug by adding lines like:

For Each oFile In objFSO.GetFolder(sFolder).Files
'new line
msgbox oFile

Open in new window

If it never shows the messagebox, you probably have the wrong path.

Bill Prew

I'm pretty sure in the FOR EACH loop oFile will return the full path, not just the file name.

Try changing this:

if (Left(LCase(oFile), 2) = "hv") and (Right(LCase(oFile), 4) = ".pdf") then

to:

if (Left(LCase(oFile.Name), 2) = "hv") and (Right(LCase(oFile.Name), 4) = ".pdf") then

»bp

ASKER CERTIFIED SOLUTION

Kimputer

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial