Attach Files with variable names to an Outlook template everyday. 1

[Xeeq]

At my job we send emails out to many different clients. Each email has it's own attachment, and each attachment has confidential information. Considering that we do all of this manually, you could guess that there are a few times a year that we accidentally attach Client1's file to Client2's email. You can see how this is a major problem. I have been assigned to make these slip-ups go away. I decided to use VBScript to do it but I am not a programmer, so I am having trouble with a few things. I have Outlook template files saved to my computer with the "To" and "Body" all ready to go. I also have a folder for each client with "attachments" that I update everyday. I already have a script that will open the templates. I now need script to attach the file to the template and to fill in the "From" section of the email. A couple of issues I have is: 1. Sometimes there are more than one file that I need to attach, so I need VBS to check for those extra files. 2. I have multiple files archived in this folder that I do NOT want to send. 3. Everyone in my office saves these files in this format (CLIENTNAME month day.pdf) The variable file name would just be a word added onto the end after "day". The date will always be yesterday's date. Any help with this would be greatly appriciated. I know there has to be a way to create variables in the script, but I don't know how to do it.

 

[PHV]

What have you tried so far and where in your code are you stuck ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[Xeeq]

Here is the code i have to open the template, and it does what i want it to do. This is the only part I got right, unfortunately.


Sub Run(ByVal sFile)
Dim shell

Set shell = CreateObject("WScript.Shell")
shell.Run Chr(34) & sFile & Chr(34), 1, false
Set shell = Nothing
End Sub

Run "C:\Users\Lee\Documents\Email Templates\client1.oft"




Then I tried to insert another code to attach a file to that template. Afterward, I realized that I am going to need a code that keeps up with the change in date in the file name and I have no clue what direction to go in to get that. Not to mention, this code did not even attach anything. I also tried to fill in the "from" section of the email, but it did not work. Here is the rest of the code:

set imsg=createobject("cdo.message")

Dim iBp
Set iBp = iMsg.AddAttachment("C:\Users\Lee\Documents\Morning Reports\client1\rig1\well1-Sep-17 tripping.pdf")

set objMail = WScript.CreateObject("CDo.Message")
objMail.From = "myemail@mydomain"


I just started working with VBscript about a week ago so I know I may have some really simply mistakes in my code.





The only knowledge is knowing that you know nothing.

 

[Xeeq]

Sorry but I have to "bump". I am still having great difficulty with this subject. Any help would be great.




The only knowledge is knowing that you know nothing.

 

[Geates]

decide whether you want to send emails based on the attachments that exist or clients. Parse the files by client into a dictionary. traverse the dictionary to send emails.

Generic, untested, and off the top of my head. Expect errors:

const UNKNOWN = "Chickenless Soup"

dim arrAttachments()

set objFSO = CreateObject("Scripting.FileSystemObject")
set colFiles = objFSO.GetFolder("C:\Attachments").Files
set dicClients = CreateObject("Scripting.Dictionary")
strFrom = "me@domain.com"
strSubject = "Daily Attachments"
strMessage = "Here are your daily attachments"

function getYesterday()
   select case (month(date - 1))
      case 1 : strMonth = "Jan"
      case 2 : strMonth = "Feb"
      case 3 : strMonth = "Mar"
      case 4 : strMonth = "Apr"
      case 5 : strMonth = "May"
      case 6 : strMonth = "Jun"
      case 7 : strMonth = "Jul"
      case 8 : strMonth = "Aug"
      case 9 : strMonth = "Sept"
      case 10 : strMonth = "Oct"
      case 11 : strMonth = "Nov"
      case 12 : strMonth = "Dec"
   end select

   getYesterdaay = strMonth & "_" & day(date - 1)
end function

function isFileValid(strFileName)
   isFileValid = false
   'Assuming the files have the same nomeclature of Client_month_day_var.pdf
   arrTokens = split(strFileName, "_")
   strMonth = arrTokens(1)
   strDay = arrTokens(2)
   
   if (getYesterday() = strMonth & "_" & strDay) then
      if (right(strFileName, 4) = ".pdf") then
         isFileValid = true
      end if
   end if
end function


for each objFile in colFiles
   'Assuming the files have the same nomeclature of Client_month_day_var.pdf
   if (isFileValid(objFile.Name)) then
      strClient = left(objFile.Name, instr(objFile.Name, "_")
      select case lcase(strClient)
         case "bob" : strTo = "bob@organics.com"
         case "joe" : strTo = "boss@capital.com"
         case "janet" : strTo = "janet@office.gov"
         case else : strTo = UNKNOWN
      end select

      if (strTo <> UNKNOWN) then
         if NOT (dicClients.Exists(strClient)) then
             dicClients.Add strClient, array(strTo)
         end if

         arrAttachments = dicClients.Item(strClient)
         intIndex = ubound(arrAttachments) + 1
         redim preserve arrAttachment(intIndex)
         arrAttachment(intIndex) = objFile.Path
         dicClients.Item strClients, arrAttachments
      end if
   end if
next

arrClients = dicClients.Keys
for i = 0 to ubound(arrClients)
   strClient = arrClients(i)
   arrAttachments = dicClients.Item(strClient)
   
   set objEmail = CreateObect("cdo.message")
   objEmail.To = arrAttachments(0)
   objEmail.From = strFrom
   objEmail.Subject = strSubject
   objEmail.Message = strMessage

   for j = 1 to ubound(arrAttachments)
      objEmail.AddAttachment(arrAttachments(j))
   next

   objEmail.Send
next

-Geates

"I hope I can chill and see the change - stop the bleed inside and feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer

 

[Xeeq]

Awesome, I will try this and get back to you.





The only knowledge is knowing that you know nothing.

 

[Xeeq]

You said "Parse the files by client into a dictionary. traverse the dictionary to send emails." Could you elaborate? I do not know how to do that. Thank you

P.S. Code looks great , only two very minor type-Os.




The only knowledge is knowing that you know nothing.

 

[Geates]

Wow, only two typos! That good, but again, it's untested some I don't know if the functionality is working.

I was outlining the code. [red]Parse the files by client into a dictionary.[/red] [blue] Traverse the dictionary to send emails.[/blue] This link is a reference to vbs. It will help you make sense of the "senseless".

http://raqxtr.sstar.com/caspdoc/html/vbscript_language_reference.htm

const UNKNOWN = "Chickenless Soup"

dim arrAttachments()

set objFSO = CreateObject("Scripting.FileSystemObject")
set dicClients = CreateObject("Scripting.Dictionary")

strFrom = "me@domain.com"
strSubject = "Daily Attachments"
strMessage = "Here are your daily attachments"

function getYesterday()
   select case (month(date - 1))
      case 1 : strMonth = "Jan"
      case 2 : strMonth = "Feb"
      case 3 : strMonth = "Mar"
      case 4 : strMonth = "Apr"
      case 5 : strMonth = "May"
      case 6 : strMonth = "Jun"
      case 7 : strMonth = "Jul"
      case 8 : strMonth = "Aug"
      case 9 : strMonth = "Sept"
      case 10 : strMonth = "Oct"
      case 11 : strMonth = "Nov"
      case 12 : strMonth = "Dec"
   end select

   getYesterdaay = strMonth & "_" & day(date - 1)
end function


function isFileValid(strFileName)
   isFileValid = false
   'Assuming the files have the same nomeclature of Client_month_day_var.pdf
   arrTokens = split(strFileName, "_")
   strMonth = arrTokens(1)
   strDay = arrTokens(2)
   
   if (getYesterday() = strMonth & "_" & strDay) then
      if (right(strFileName, 4) = ".pdf") then
         isFileValid = true
      end if
   end if
end function

[red]

set colFiles = objFSO.GetFolder("C:\Attachments").Files
for each objFile in colFiles
   'Assuming the files have the same nomeclature of Client_month_day_var.pdf
   if (isFileValid(objFile.Name)) then
      strClient = left(objFile.Name, instr(objFile.Name, "_")
      select case lcase(strClient)
         case "bob" : strTo = "bob@organics.com"
         case "joe" : strTo = "boss@capital.com"
         case "janet" : strTo = "janet@office.gov"
         case else : strTo = UNKNOWN
      end select

      if (strTo <> UNKNOWN) then
         if NOT (dicClients.Exists(strClient)) then
             dicClients.Add strClient, array(strTo)
         end if

         arrAttachments = dicClients.Item(strClient)
         intIndex = ubound(arrAttachments) + 1
         redim preserve arrAttachment(intIndex)
         arrAttachment(intIndex) = objFile.Path
         dicClients.Item strClients, arrAttachments
      end if
   end if
next
[/red]

[blue]
arrClients = dicClients.Keys
for i = 0 to ubound(arrClients)
   strClient = arrClients(i)
   arrAttachments = dicClients.Item(strClient)
   
   set objEmail = CreateObect("cdo.message")
   objEmail.To = arrAttachments(0)
   objEmail.From = strFrom
   objEmail.Subject = strSubject
   objEmail.Message = strMessage

   for j = 1 to ubound(arrAttachments)
      objEmail.AddAttachment(arrAttachments(j))
   next

   objEmail.Send
next
[/blue]

-Geates

"I hope I can chill and see the change - stop the bleed inside and feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer

 

[Xeeq]

I getting this error "Object doesn't support this property or method: 'objEmail.Message'" at the last line of the following section.

set objEmail = CreateObect("cdo.message")
objEmail.To = arrAttachments(0)
objEmail.From = strFrom
objEmail.Subject = strSubject
objEmail.Message = strMessage

Any ideas? I have not been able to get past this one.




The only knowledge is knowing that you know nothing.

 

[Geates]

It means the object objEmail (cdo.outlook) has no function called message. A quick google search for CDO.Outlook Object shows the correct method is objEmail.Textbody. I recommend learning about the cdo.outlook object.

-Geates

"I hope I can chill and see the change - stop the bleed inside and feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer

 

[PHV]

I'd use the TextBody property instead of Message.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[Xeeq]

lol, that's kind of funny, because I tried "objEmail.Text" and "objEmail.Body" but did not try "objEmail.Textbody". Ok, I'm gonna continue.




The only knowledge is knowing that you know nothing.

 

[PHV]

Have a look here:
thread705-1369407

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[Xeeq]

Now I am getting "Subscript out of range 'ubound'" at this section

for j = 1 to ubound(arrAttachments)
objEmail.AddAttachment(arrAttachments(j))
next




The only knowledge is knowing that you know nothing.

 

[Geates]

that would suggest the arrAttachments contains no values.

-Geates

"I hope I can chill and see the change - stop the bleed inside and feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer

 

[Xeeq]

Please keep in mind, and like I said earlier, I just started working with VB Script about a week before this thread, so I only know the very basics of how this all works. I do not know how to give the an array values. I have read up on arrays and looked at codes for various arrays, but I don't completely understand it. What should I do in this specific circumstance to fix my current problem?




The only knowledge is knowing that you know nothing.

 

[Xeeq]

Ok, I just got past the array problem I was having. The good news is, the code returns no errors when I run it. The bad news is, it does nothing at all when I run it.


I will post the finalized code, but understand for privacy, I had to change client names to "Client" and asset names to "asset". I also changed email addresses for the same reason:


Sub Run(ByVal sFile)
Dim shell

Set shell = CreateObject("WScript.Shell")
shell.Run Chr(34) & sFile & Chr(34), 1, false
Set shell = Nothing
End Sub




'Run "C:\Users\Lee\Documents\Email Templates\client (asset).oft"



const UNKNOWN = "Chickenless Soup"

dim arrAttachments(2)

set objFSO = CreateObject("Scripting.FileSystemObject")
set colFiles = objFSO.GetFolder("C:\Users\Lee\Documents\Morning Reports\client").Files
set dicClients = CreateObject("Scripting.Dictionary")
strFrom = "myaltemail@domain.com"
strCc = "coworkers@domain.com"
strSubject = "Here you go"
strMessage = "Here you go"

function getYesterday()
select case (month(date - 1))
case 1 : strMonth = "Jan"
case 2 : strMonth = "Feb"
case 3 : strMonth = "Mar"
case 4 : strMonth = "Apr"
case 5 : strMonth = "May"
case 6 : strMonth = "Jun"
case 7 : strMonth = "Jul"
case 8 : strMonth = "Aug"
case 9 : strMonth = "Sept"
case 10 : strMonth = "Oct"
case 11 : strMonth = "Nov"
case 12 : strMonth = "Dec"
end select

getYesterdaay = strMonth & "_" & day(date - 1)
end function

function isFileValid(strFileName)
isFileValid = false
'Assuming the files have the same nomeclature of Client_month_day_var.pdf
arrTokens = split(strFileName, "_")
strMonth = arrTokens(1)
strDay = arrTokens(2)

if (getYesterday() = strMonth & "_" & strDay) then
if (right(strFileName, 4) = ".pdf") then
isFileValid = true
end if
end if
end function


for each objFile in colFiles
'Assuming the files have the same nomeclature of Client_month_day_var.pdf
if (isFileValid(objFile.Name)) then
strClient = left(objFile.Name, instr(objFile.Name, "_"))
select case lcase(strClient)
case "asset" : strTo = "manypeople@domain.com"

case else : strTo = UNKNOWN
end select

if (strTo <> UNKNOWN) then
if NOT (dicClients.Exists(strClient)) then
dicClients.Add strClient, array(strTo)
end if

arrAttachments = dicClients.Item(strClient)
intIndex = ubound(arrAttachments) + 1
redim preserve arrAttachment(intIndex)
arrAttachment(intIndex) = objFile.Path
dicClients.Item strClients, arrAttachments
end if
end if
next

arrClients = dicClients.Keys
for i = 0 to ubound(arrClients)
strClient = arrClients(i)
arrAttachments = dicClients.Item(strClient)
next



set objEmail = CreateObject("cdo.message")
objEmail.To = strTo
objEmail.From = strFrom
objEmail.Subject = strSubject
objEmail.Textbody = strMessage


for j = 1 to ubound(arrAttachments)
objEmail.AddAttachment(arrAttachments(j))
next



As you can see, I commented out the line that runs the outlook template that i have created, because it appears that I don't need that with this code. Although, I would prefer to send from that template as it is already set up with the following : To, Cc, Subject, and Body. If I can get the current code to work, I won't worry about the template. If you can see any errors that would make this code do nothing when run, let me know. Thanks

P.S. I appreciate all the help you guys have given me, and if you could hold out for a bit longer I would be very grateful. I believe we are almost there




The only knowledge is knowing that you know nothing.

 

[Geates]

if it's doing nothing either there are no files in the directory or none of the files match the criteria needed for being attached. Time to start troubleshooting "line by line". Comment out the the code in the for..each loop and replace it with the code below. Check out both with a simple msgbox to see what values are being considered. Find out what file is currently being processed. The see if it passes the fileValid() function. If you get message boxex with the expected values, then you know the problem lies elsewhere. Let me know what the results are and we'll investigate from there.

for each objFile in objFiles
   [red]msgbox "Current File: " & objFile.Path[/red]
   if (isFileValid(objFile.Name)) then
      [blue]msgbox objFile.Name & "is valid"[/blue]
   else
      [blue]msgbox objFile.Name & "is NOT valid"[/blue]
   end if
next

-Geates

"I hope I can chill and see the change - stop the bleed inside and feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer

 

[Xeeq]

Wow, that took me forever, but I have some advancements. I had all kinds of problems. First off, I had the "objFSO.GetFolder" set in a fold with no files in it. I corrected that, then realized all of my attachment file names are separated by dashes and not underscores. I fixed that, but still nothing. Then I realized that I had no attachment in that folder from yesterday, lol. After fixing that I still had nothing. So, I started troubleshooting with the filevalid function. Using that tool, I found that the problem lies in the "getyesterday" and/or "arrToken" code. I have tried to tweak on it but I have had no luck. Here is the code and a pretend file name, maybe you will have better luck than me. "Who No 002" takes the place of the client's asset name but I kept the same format. "poop" takes the place of a variable word in the file name. BTW, just to clarify, the client's name won't actually be in the file name, but there "asset" name will be. Don't know if it even make sa difference.

File: Who No 002-Oct-24 poop.pdf

Code:


function getYesterday()
select case (month(date - 1))
case 1 : strMonth = "Jan"
case 2 : strMonth = "Feb"
case 3 : strMonth = "Mar"
case 4 : strMonth = "Apr"
case 5 : strMonth = "May"
case 6 : strMonth = "Jun"
case 7 : strMonth = "Jul"
case 8 : strMonth = "Aug"
case 9 : strMonth = "Sept"
case 10 : strMonth = "Oct"
case 11 : strMonth = "Nov"
case 12 : strMonth = "Dec"
end select


getYesterday = strMonth & "-" & day(date - 1)
end function



function isFileValid(strFileName)
isFileValid = false
'Assuming the files have the same nomeclature of Client_month_day_var.pdf
arrTokens = split(strFileName, "-")
strMonth = arrTokens(1)
strDay = arrTokens(2)


if (getYesterday() = strMonth & "-" & strDay) then
if (right(strFileName, 4) = ".pdf") then
isFileValid = true
end if
end if
end function

for each objFile in colFiles
'Assuming the files have the same nomeclature of Client_month_day_var.pdf
if (isFileValid(objFile.Name)) then
strClient = left(objFile.Name, instr(objFile.Name, "-"))
select case lcase(strClient)





The only knowledge is knowing that you know nothing.

 

[Geates]

please put code inside the [ignore]

[/ignore]

the problem is in the isFileValid, but only because of the name of the file

the file is named "Who No 002-Oct-24 poop.pdf". arrTokens = split(filename, "-"). Thus, your tokens will be

1. "Who No 002"
2. "Oct" (strMonth)
3. "24 poop.pdf" (strDay)

getYesterday() will never equal "Oct-24 poop.pdf"

Find a different way to name your files so they can be parse correctly.

-Geates

"I hope I can chill and see the change - stop the bleed inside and feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer