Forum Discussion

rmanning's avatar
rmanning
Contributor
14 years ago

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

  • 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






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


  • Hi,



    Remove Set from the problematic line. You should use Set only with objects, not with simple types.
  • 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...
  • 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!
  • 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!
  • 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!