Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Attachments 2

Status
Not open for further replies.

Robf279

Technical User
May 27, 2015
5
GB
Hi,

I'm new here, but wondering if anyone can offer some assistance with a bit of code i am writing.

Some quick background, we have a customer that wants to receive all of their invoices via email once per month. We have a store for the invoices, which i am planning on downloading the files from, and then attaching them to multiple emails, attaching a maximum of 25 invoices per email to keep the email sizes down. The customer receives about 180+ invoices a month currently from us, so you can understand why they would want these coming in a few emails rather than hundreds.

Below is the VBScript as far as i have been able to get it, but i need a way of it knowing once it gets to 25 attachments added, that it needs to create a new email.


vbscript said:
strFolder = "G:\Scripts\Files\"
strExt = "pdf"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolder)

For Each objFile in objFolder.Files
strFileExt = objFSO.GetExtensionName(objFile.Path)

strFile = objFile.Path
next

'email the files, there are usually no more than 3 files.
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "test email script"
objMessage.From = "***@***.com"
objMessage.To = "****@***.com"
objMessage.TextBody = "Please see the attached files"
For Each objFile In objFolder.Files
strFileExt = objFSO.GetExtensionName(objFile.Path)
objMessage.AddAttachment objFile.Path
Next

objMessage.Configuration.Fields.Item (" = 2
objMessage.Configuration.Fields.Item (" = "******@******.com"
objMessage.Configuration.Fields.Item (" = 25
objMessage.Configuration.Fields.Update
objMessage.Send



Thanks,

Rob
 
Why not simply zip the attachments and send a .zip file? Not sure how big the invoices are but you could possibly send them all at once.

Swi
 
Hi Swi,

Thank you for this, however the customer has already rejected this option, as they just want the individual files attached to emails.

Thanks,

Rob
 
The pseudocode for what you have now is something like:

[pre]Create Message object, assign subject, from, to, textbody etc.
For each file found in the folder
add attachment
Next
send the email with the attachments
[/pre]


The pseudocode for what you want might be something like:

[pre]Create Message object, assign subject, from, to, textbody etc.
For each file found in the folder
add attachment
increment counter
if we have added our 25th attachment
send this email with 25 attachments
create a new message object with subject, to, from, textbody etc
reset the counter
end if
Next

if the counter is not zero, send the email with the remaining attachments
[/pre]

I color coded the redundant parts, you might want a subroutine to do that part.
 
Insomnia sucks but it is good for coding, here you go. Change the parts in red.

Code:
InvoiceStore = "[COLOR=#EF2929]C:\Temp\Test[/color]"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = objFSO.GetFolder(InvoiceStore)

iCount = 0

For Each oFile In oFolder.Files
	' overall counter to determine place within list of all files
	oCount = oCount + 1
	'interim counter to determine when we reach 25 attachments
	iCount = iCount + 1
	'build the attachment list
	AttachList = AttachList & ";" & Chr(34) & oFile.Path & Chr(34)
	'check if we are at 25 files or at the end of the list and send email
	If (iCount = 25) Or (oCount = oFolder.Files.Count) Then
		SendMail AttachList
		AttachList = ""
		iCount = 0
	End If
Next


Function SendMail(AttachmentList)
	Dim strFrom, strMyIP, strTo
	 
	' Set the company specific information
	strFrom = "[COLOR=#EF2929]yourname@yourcompany.com[/color]"
	' Set the SMTP server IP
	strMyIP = "[COLOR=#EF2929]mail.yourcompany.com[/color]" 
	' Where do you want the message to be delivered
	' Use semicolons to seperate multiple addresses
	strTo = "[COLOR=#EF2929]customer@invoicecompany.com[/color]"
	
	
	' Set the visual basic constants as they do not exist within VBScript.
	' Do not set your smtp server information here.
	Const cdoSendUsingMethod = "[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/sendusing",[/URL] _
	cdoSendUsingPort = 2, _
	cdoSMTPServer = "[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserver"[/URL]
	
	' Create the CDO connections.
	Dim iMsg, iConf, Flds
	Set iMsg = CreateObject("CDO.Message")
	Set iConf = CreateObject("CDO.Configuration")
	Set Flds = iConf.Fields
	
	' SMTP server configuration.
	With Flds
	.Item(cdoSendUsingMethod) = cdoSendUsingPort
	
	' Set the SMTP server address here.
	.Item(cdoSMTPServer) = strMyIP
	.Update
	End With
	
	' Set the message properties.
	With iMsg
	Set .Configuration = iConf
	.To = strTo
	.From = strFrom
	.Subject = "Monthly Invoices"
	.TextBody = "Attached please find this month's invoices."
	' An attachment can be included.
	.AddAttachment AttachmentList
	End With
	
	'Send high priority
	iMsg.Fields.Item("urn:schemas:mailheader:X-MSMail-Priority") = "High" ' For Outlook 2003
	iMsg.Fields.Item("urn:schemas:mailheader:X-Priority") = 2 ' For Outlook 2003 also
	iMsg.Fields.Item("urn:schemas:httpmail:importance") = 2 ' For Outlook Express
	iMsg.Fields.Update
	
	'Send the message.
	iMsg.Send 
End Function

I hope that helps.

Regards,

Mark

No trees were harmed in posting this message, however a significant number of electrons were terribly inconvenienced.

Check out my scripting solutions at
Work SMARTER not HARDER.
 
Hi,

Thank you both for your help with this, i have got this solution working now.

Thanks,

Rob
 
Did you go with another solution or one of the ones offered here?
 
Hi Mark,

I went with the advice and assistance that was provided here, and it certainly set me on the right path to get this resolved.

Thank you.
 
Hi,

I've come across a further issue, that i hope you can assist with. Basically i don't want to manually have to change the dates required for the files on a monthly basis, i would like to have this dynamic, so that it can automatically change the dates and run via a scheduled task.

Below is the code that i have - the sensitive parts coded out.

I have colour coded the part i'm really struggling to get to work with the dates, as i'm looking to do an if date modified is between x and y then attach if not ignore.

Code:
'' This part of the code pulls the invoices from a folder and creates and sends the emails which each contain 25 attachments
'' Set the folder and the extention for the files
strFolder = "G:\Scripts\Files\"
strExt = "pdf"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolder)

''Loop through to get the files/extentions and set as a new variable that holds all of the information.
For Each objFile in objFolder.Files
strFileExt = objFSO.GetExtensionName(objFile.Path)
strFile = objFile.Path
CurrMonth = DatePart("m",now())
CurrYear = DatePart("yyyy",now())
[COLOR=#EF2929]StartDate = FormatDateTime("02/"& CurrMonth -1 & "/" & CurrYear,vbShortDate) & " 00:00:00"
EndDate = FormatDateTime("01/"& CurrMonth & "/" & CurrYear,vbShortDate) & " 23:59:59"[/color]
next

''Create an email
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "test email script"
objMessage.From = "invoices@***.***"
objMessage.To = "***@***.***"
objMessage.TextBody = "Please see the attached files"
''Set a counter so that we can track how many attachments have been added.
counter = 0
'' for each of the files in the folder add them as an attachment
For Each objFile In objFolder.Files 
[COLOR=#EF2929]If StartDate > objFile.DateLastModified and EndDate > objFile.DateLastModified Then[/color]  
strFileExt = objFSO.GetExtensionName(objFile.Path)
objMessage.AddAttachment objFile.Path
''Increase the counter by 1 for each file added
counter = counter + 1
end if 

''If statement for when the counter has reached 25.
if counter => 25 then
''Send the email
objMessage.Configuration.Fields.Item ("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/sendusing")[/URL] = 2
objMessage.Configuration.Fields.Item ("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserver")[/URL] = "***.***.***" 
objMessage.Configuration.Fields.Item ("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserverport")[/URL] = 25
objMessage.Configuration.Fields.Update
objMessage.Send
''Reset the counter to 0 to allow the process to repeat
counter = 0
''Create a new email
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "test email script"
objMessage.From = "invoices@***.***"
objMessage.To = "***@***.***"
objMessage.TextBody = "Please see the attached files"
''end the iff statement and then start the loop again.
end if
next
''If the folder has run out of files, check to see if there are any stragglers that have managed to get themselves into the script but never made it to 25, then send these.
if counter => 1 then
objMessage.Configuration.Fields.Item ("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/sendusing")[/URL] = 2
objMessage.Configuration.Fields.Item ("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserver")[/URL] = "***.***.***" 
objMessage.Configuration.Fields.Item ("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserverport")[/URL] = 25
objMessage.Configuration.Fields.Update
objMessage.Send
end if

Any help would be brilliant, thank you.
 
Something like this ?
Code:
...
StartDate = DateSerial(Year(Now()),Month(Now())-1,2)
EndDate = DateSerial(Year(Now()),Month(Now()),2)
...
If StartDate <= objFile.DateLastModified and EndDate > objFile.DateLastModified Then
...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
how can i generate the system name, used id logged in and system OS in to a csv file by vb script?


 
Use WSHNetwork (Username and Computername) for the first two. Use WMI to query the Win32_OperatingSystem for Caption for the Windows version.

I hope that helps.

Regards,

Mark

No trees were harmed in posting this message, however a significant number of electrons were terribly inconvenienced.

Check out my scripting solutions at
Work SMARTER not HARDER.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top