Email a folder instead of individual files using script.

[rmanning]

Is there a way to attach an entire folder of images (or whatever files) using the vbscript (found here: http://www.automatedqa.com/support/viewarticle.aspx?aid=2691)



I tried:




If SendMail("ClareJ@clarejeffersoncorp.com", "mail.johnsmithcorp.com", "John Smith", "JohnS@johnsmithcorp.com", "Notification", "Hello Clare, Your application is nice.", "C:/TEMP/*.*") Then 

  Log.Message "Mail was sent"

Else 

  Log.Warning "Mail was not sent"

End If




But it errors out.  Hopefully I don't have to specify each individual file name 😞

[tppegu]

The SendMail function can only send a single attachment. The SendEmail (note different spelling) function listed at the URL you provided is able to send multiple attachments, but their names must be provided as a comma-separated list. You can generate a list of files in a folder using something like this (apologies if the syntax is wrong. I don't normally use VB) :






Function ListFiles(folder)

  Dim oFolder, colFiles, f





  Set oFolder = aqFileSystem.GetFolderInfo(folder)

  Set colFiles = oFolder.Files

  Set strFileList = ""

  aqString.ListSeparator = ","

  While colFiles.HasNext

    Set f = colFiles.Next

    strFileList = aqString.AddListItem(strFileList, f.Name)

  Wend

  ListFiles = strFileList

End Function

[rmanning]

Tried using that script today but am getting the following error (see attached screenshot);  Any ideas?

[YMinaev]

Hi,



Remove Set from the problematic line. You should use Set only with objects, not with simple types.

[rmanning]

Okay, that works (somewhat) but I'm a complete moron when it comes to VBScript, so how do I use the Email function in combination with creating this file list to email attachements?  My code is as follows:



Function ListFiles(folder)

  Dim oFolder, colFiles, f







  Set oFolder = aqFileSystem.GetFolderInfo(folder)

  Set colFiles = oFolder.Files

  strFileList = ""

  aqString.ListSeparator = ","

  While colFiles.HasNext

    Set f = colFiles.Next

    strFileList = aqString.AddListItem(strFileList, f.Name)

  Wend

  ListFiles = strFileList

End Function







Function SendEmail(mFrom, mTo, mSubject, mBody, mAttachment)






  Err.Clear

  On Error Resume Next





  schema = "http://schemas.microsoft.com/cdo/configuration/"

  Set mConfig = Sys.OleObject("CDO.Configuration")

  mConfig.Fields.Item(schema + "sendusing") = 2 ' cdoSendUsingPort

  mConfig.Fields.Item(schema + "smtpserver") = "my.smtp.server" ' SMTP server

  mConfig.Fields.Item(schema + "smtpserverport") = 25 ' Port number

  ' mConfig.Fields.Item(schema + "sendusername") = "" ' User name (if needed)

  ' mConfig.Fields.Item(schema + "sendpassword") = "" ' User password (if needed)

  mConfig.Fields.Update()





  Set mMessage = Sys.OleObject("CDO.Message")

  mMessage.Configuration = mConfig

  mMessage.From = mFrom

  mMessage.To = mTo

  mMessage.Subject = mSubject

  mMessage.HTMLBody = mBody





  aqString.ListSeparator = ","

  For i = 0 To aqString.GetListLength(mAttachment) - 1

    mMessage.AddAttachment aqString.GetListItem(mAttachment, i)

  Next





  mMessage.Send





  If Err.Number > 0 Then

    Log.Error "E-mail cannot be sent", Err.Description

    SendEMail = False

  Else

    Log.Message "Message to <" + mTo + "> was successfully sent"

    SendEMail = True

  End If

End Function



Sub MainTest


  If SendEmail("do-not-reply@mail.com", "automated@test.com", "Automated Testing", _

             "This is a test message.", ListFiles("C:/Documents and Settings/User/My Documents/TestComplete 8 Projects/Automation/Screenshots/")) Then

    ' Message was sent

  Else

    ' Message was not sent

  End If

End Sub







The script runs without error, but the attachements are not being sent (says "noname" as an attachment). 

UPDATE:  I know what the issue is.  The comma seperator is being placed at the begining of the list of files, so they show up as ",C:\temp\1.jpg, C:\temp\2.jpg, C:\temp\3.jpg" ect.  I need to remove that comma at the begining and it should work...

[rmanning]

Alright, so the comma thing at the begining was causing an issue, and I've managed to move it to the end of the array and now it works (after some other tweaks, like adding the full path to the array as well).



Anyways, like I said, I'm really new to VBScript so this may be a conveluted way to achieve this but it is working so I could care less 🙂



Here is my working script:



Function SendEmail(mFrom, mTo, mSubject, mBody, mAttachment)

 

  Err.Clear

  On Error Resume Next



  schema = "http://schemas.microsoft.com/cdo/configuration/"

  Set mConfig = Sys.OleObject("CDO.Configuration")

  mConfig.Fields.Item(schema + "sendusing") = 2 ' cdoSendUsingPort

  mConfig.Fields.Item(schema + "smtpserver") = "my.smtp.server" ' SMTP server

  mConfig.Fields.Item(schema + "smtpserverport") = 25 ' Port number

  ' mConfig.Fields.Item(schema + "sendusername") = "" ' User name (if needed)

  ' mConfig.Fields.Item(schema + "sendpassword") = "" ' User password (if needed)

  mConfig.Fields.Update()



  Set mMessage = Sys.OleObject("CDO.Message")

  mMessage.Configuration = mConfig

  mMessage.From = mFrom

  mMessage.To = mTo

  mMessage.Subject = mSubject

  mMessage.HTMLBody = mBody



    

  aqString.ListSeparator = ","

  For i = 0 To aqString.GetListLength(mAttachment) - 1

    mMessage.AddAttachment aqString.GetListItem(mAttachment, i)

  Next



  mMessage.Send



  If Err.Number > 0 Then

    Log.Error "E-mail cannot be sent", Err.Description

    SendEMail = False

  Else

    Log.Message "Message to <" + mTo + "> was successfully sent"

    SendEMail = True

  End If

End Function



Sub MainTest

 

  Set oFolder = aqFileSystem.GetFolderInfo("C:\Documents and Settings\User\My Documents\TestComplete 8 Projects\Automation\Screenshots")

  Set colFiles = oFolder.Files

  strFileList = ""

  aqString.ListSeparator = ","

  While colFiles.HasNext

    Set f = colFiles.Next

    strFileList = aqString.AddListItem("C:/Documents and Settings/User/My Documents/TestComplete 8 Projects/Automation/Screenshots/" + f.Name, strFileList)

  Wend

  ListFiles = strFileList



  If SendEmail("sent-from@email.com", "send-to@email.com", "Automated Testing", _

             "This is a test message.", "" + ListFiles + "") Then

    ' Message was sent

  Else

    ' Message was not sent

  End If

End Sub





If someone knows a cleaner way to achieve this, or a way to remove the additional comma at the end of the ListFiles array (which causes a "noname" attachement to be attached along with the entire folder contents) then I'd be interested in hearing your solutions.  Otherwise, I'm happy that it at least works and is doing what I require 🙂



Thanks for all your help! Much appreciated!

[rmanning]

Little worried to ask as this could cause potential security issues, but is there a way to delete the entire contents of a folder using VBScript?  That way I could "flush" this screenshots folder at the start of the script routine to avoid attaching images from previous executions of the script.



UPDATE:  I've figured out how to deleted or flush the directory by inserting the following code before the End Sub line of the MainTest:



For Each aFile In oFolder.Files

   aFile.Delete

Next 



However, I've notice I will get an error if the screenshots folder is empty and the email script is ran (see attached image);  Is there any way to change this so to avoid this error?  I will do my best to figure out a solution, but if anyone has any insight, please feel free to share 🙂



Thanks!

[rmanning]

Okay, I think I'm on to somthing but cannot seem to make it work.



As found on this site: http://www.winfrastructure.net/article.aspx?BlogEntry=VBScript-to-check-if-folder-is-empty



What I'm trying to do is see if either oFolder is empty then set it to another folder with a generic image placed in it, using something like so:



If oFolder.Files.Count = 0 Then

  Set oFolder = aqFileSystem.GetFolderInfo("F:\temp2")  

End If



But I keep getting an error.   If anyone has any suggestions, I'm all ears...



UPDATE:



I've managed to get it working.   Basically, I am now using the following two scripts:



For taking screenshots:



Sub Main

If aqFileSystem.Exists("F:\temp") Then

Sys.Desktop.ActiveWindow().Picture.SaveToFile "F:\temp\" + VarToStr(Project.Variables.Screenshot_Filename)

Else

aqFileSystem.CreateFolder("F:\temp")

Sys.Desktop.ActiveWindow().Picture.SaveToFile "F:\temp\" + VarToStr(Project.Variables.Screenshot_Filename)       

End If

End Sub    



And emailing logs/screenshots:



Function SendEmail(mFrom, mTo, mSubject, mBody, mAttachment)

 

  Err.Clear

  On Error Resume Next



  schema = "http://schemas.microsoft.com/cdo/configuration/"

  Set mConfig = Sys.OleObject("CDO.Configuration")

  mConfig.Fields.Item(schema + "sendusing") = 2 ' cdoSendUsingPort

  mConfig.Fields.Item(schema + "smtpserver") = "smtp.mailserver.address" ' SMTP server

  mConfig.Fields.Item(schema + "smtpserverport") = 25 ' Port number

  ' mConfig.Fields.Item(schema + "sendusername") = "" ' User name (if needed)

  ' mConfig.Fields.Item(schema + "sendpassword") = "" ' User password (if needed)

  mConfig.Fields.Update()



  Set mMessage = Sys.OleObject("CDO.Message")

  mMessage.Configuration = mConfig

  mMessage.From = mFrom

  mMessage.To = mTo

  mMessage.Subject = mSubject

  mMessage.HTMLBody = mBody

   

  aqString.ListSeparator = ","

  For i = 0 To aqString.GetListLength(mAttachment) - 1

    mMessage.AddAttachment aqString.GetListItem(mAttachment, i)

  Next



  mMessage.Send



  If Err.Number > 0 Then

    Log.Error "E-mail cannot be sent", Err.Description

    SendEMail = False

  Else

    Log.Message "Message to <" + mTo + "> was successfully sent"

    SendEMail = True

  End If

End Function



Sub MainTest

' checks to see if there are any existing screenshots

If aqFileSystem.Exists("F:\temp") Then

  Set oFolder = aqFileSystem.GetFolderInfo("F:\temp")  

Else

  Set oFolder = aqFileSystem.GetFolderInfo("F:\temp2")  

End If

 

  Set colFiles = oFolder.Files

  strFileList = ""

  aqString.ListSeparator = ","

  While colFiles.HasNext

    Set f = colFiles.Next

    strFileList = aqString.AddListItem(oFolder.Path + "\" + f.Name, strFileList)

  Wend

  ListFiles = strFileList



' this executes the email function  

  If SendEmail("from@email.com", "to@email.com", "Subject", _

             "Message Body", "" + ListFiles + "") Then

    ' Message was sent

  Else

    ' Message was not sent

  End If



' deletes the screenshot folder

If aqFileSystem.Exists("F:\temp") Then     

For Each aFile In oFolder.Files

   aFile.Delete

Next

aqFileSystem.DeleteFolder("F:\temp")  

End If

  

End Sub



And as long as I set my variable for the screenshot filename (along with some other stuff that I removed from the example above) it works beautifully!  (and I didn't erase my entire C: drive in the process!)



So thanks for letting me chat to myself on here today 🙂  Regardless, I have it working the way I like and I couldn't have gotten to this point without all of your help.



Thanks again!