Ask a Question

Email a folder instead of individual files using script.

rmanning
Contributor

Email a folder instead of individual files using script.

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 😞
7 REPLIES 7
tppegu
Contributor

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
Contributor

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


YMinaev
Staff

Hi,



Remove Set from the problematic line. You should use Set only with objects, not with simple types.
------
Yuri
TestComplete Customer Care Engineer

Did my reply answer your question? Give Kudos or Accept it as a Solution to help others. ⬇️⬇️⬇️
rmanning
Contributor

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
Contributor

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
Contributor

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
Contributor

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!
cancel
Showing results forΒ 
Search instead forΒ 
Did you mean:Β