I am creating a script to be placed on servers to run without user interaction that will send an email when certain criteria are met. I have the criteria script running, but I want to make the script easy to deploy and modify for each individual server.
I am trying to make the script make a call to a text file to populate the TO field in the email. The text file will have the email addresses placed one per line (I was putting a semicolon on the end of the addresses since I know multiple TO addresses are separated by semicolons)
I have tried a number of different variations on calling the script and I either get an error on the To line, or it makes it through the script and I get an error that no recipients were defined. Here is the script below:
`Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objFileEmailAddresses = objFSO.OpenTextFile("EmailAddresses.txt", 1)
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set wshShell = WScript.CreateObject("WScript.Shell")
strComputerName = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
ServicesArray = Split (objFileEmailAddresses.ReadAll, vbNewLine)
For Each strService In ServicesArray
objDictionary.Add strService, strService
Next
Set objEmail = CreateObject("CDO.Message")
objEmail.From = "email#server.com"
objEmail.To = objFileEmailAddresses
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp address"
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Fields.Item("urn:schemas:mailheader:X-MSMail-Priority") = "High"
objEmail.Fields.Item("urn:schemas:mailheader:X-Priority") = 2
objEmail.Fields.Item("urn:schemas:httpmail:importance") = 2
objEmail.Fields.Update
objEmail.Subject = "Primary Server " & Ucase(strComputerName) & " is Rebooting Now"
objEmail.TextBody ="The primary server " & Ucase(strComputerName) & " is scheduled to reboot at this time. The server will be offline in less than one minute. .... "
objEmail.Send
objFileEmailAddresses.Close()`
The To field of your objEmail object should be a string containing one or more e-mail addresses. You're assigning a TextStream object (objFileEmailAddresses) to it.
You said your e-mail addresses already end with a semicolon? Try this instead:
' Open the text file containing all of the e-mail addresses...
Set objFileEmailAddresses = objFSO.OpenTextFile("EmailAddresses.txt", 1)
' Read the entire file. Replace newlines with nothing to get a single
' string of semicolon-separated e-mail addresses...
strAddresses = Replace(objFileEmailAddresses.ReadAll, vbCrLf, "")
' Assign the string to the e-mail object...
objEmail.To = strAddresses
You can get rid of the Dictionary object. Unless you're afraid you may have the same e-mail addresses listed more than once, in which case we may need to use one.
Related
I'm looking for a VBA macro that scrapes outlook for specific, most recent, e-mails that are received MTWTF, saves the .xlsm and .xlsx attachments in a local folder, then another macro to look in to these recently saved files and paste specific tabs in to an excel workbook.
I receive three daily e-mails with static subjects with only the date changing daily. One of the e-mail attachments has a password on it.
Steps-
Search Outlook for the most recent "ABC E-mail subject" and save down attachment in local folder
1.1) Search Outlook for the most recent "DEF E-mail subject" and save down attachment in local folder
1.2) Search Outlook for the most recent "XYZ E-mail subject", enter attachment password and save down attachment in local folder
Ignore older versions of the same e-mail
Look in to the saved down ABC, DEF, and XYZ (again entering the password if needed) files, copy 2+ tabs from each file in to an Excel template
Thank you!!
**What's been tried:
**
On the following code, this object can not be found:
fol = ns.Folders(1).Folders("Dell")
I've created the folder in a shared outlook e-mail/group. I've referenced MicroSoft 16 object library in Tools > References.
Option Explicit
Sub SaveOutlookAttachments()
'This early-binding version requires a reference to the Outlook and Scripting Runtime object libraries
Dim ol As Outlook.Application
Dim ns As Outlook.Namespace
Dim fol As Outlook.Folder
Dim i As Object
Dim mi As Outlook.MailItem
Dim at As Outlook.Attachment
Dim fso As Scripting.FileSystemObject
Dim dir As Scripting.Folder
Dim dirName As String
Set fso = New Scripting.FileSystemObject
Set ol = New Outlook.Application
Set ns = ol.GetNamespace("MAPI")
Set fol = ns.Folders(1).Folders("Dell")
For Each i In fol.Items
If i.Class = olMail Then
Set mi = i
If mi.Attachments.Count > 0 Then
'Debug.Print mi.SenderName, mi.ReceivedTime, mi.Attachments.Count
dirName = _
"C:\Outlook Files\" & _
Format(mi.ReceivedTime, "yyyy-mm-dd hh-nn-ss ") & _
Left(Replace(mi.Subject, ":", ""), 10)
If fso.FolderExists(dirName) Then
Set dir = fso.GetFolder(dirName)
Else
Set dir = fso.CreateFolder(dirName)
End If
For Each at In mi.Attachments
'Debug.Print vbTab, at.DisplayName, at.Size
at.SaveAsFile dir.Path & "\" & at.Filename
Next at
End If
End If
Next i
End Sub
Sub SaveOutlookAttachmentsLateBinding()
'This late-binding version allows you to remove the references to the Outlook and Scripting Runtime object libraries
Dim ol As Object 'Outlook.Application
Dim ns As Object 'Outlook.Namespace
Dim fol As Object 'Outlook.Folder
Dim i As Object
Dim mi As Object 'Outlook.MailItem
Dim at As Object 'Outlook.Attachment
Dim fso As Object 'Scripting.FileSystemObject
Dim dir As Object 'Scripting.Folder
Dim dirName As String
Set fso = CreateObject(Class:="Scripting.FileSystemObject")
Set ol = CreateObject(Class:="Outlook.Application")
Set ns = ol.GetNamespace("MAPI")
Set fol = ns.Folders(1).Folders("Dell")
For Each i In fol.Items
If i.Class = 43 Then
Set mi = i
If mi.Attachments.Count > 0 Then
'Debug.Print mi.SenderName, mi.ReceivedTime, mi.Attachments.Count
dirName = _
"C:\Outlook Files\" & _
Format(mi.ReceivedTime, "yyyy-mm-dd hh-nn-ss ") & _
Left(Replace(mi.Subject, ":", ""), 10)
If fso.FolderExists(dirName) Then
Set dir = fso.GetFolder(dirName)
Else
Set dir = fso.CreateFolder(dirName)
End If
For Each at In mi.Attachments
'Debug.Print vbTab, at.DisplayName, at.Size
at.SaveAsFile dir.Path & "\" & at.Filename
Next at
End If
End If
Next i
End Sub
Instead of getting folders by index from the Namespace class:
Set fol = ns.Folders(1).Folders("Dell")
Use the GetDefaultFolder method of the Namespace class which returns a Folder object that represents the default folder of the requested type for the current profile; for example, obtains the default Inbox folder for the user who is currently logged on.
Then instead of iterating over all items in the folder and checking whether each item has attached files:
For Each i In fol.Items
If i.Class = 43 Then
Set mi = i
If mi.Attachments.Count > 0 Then
You need to use the Find/FindNext or Restrict methods of the Items class. They allow getting only items that correspond to the search criteria, so you can iterate over items that has attachments (and if required belong to a specified date range). There is no need to check each item in the folder separately in the loop. Read more about these methods in the articles that I wrote for the technical blog:
How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
How To: Use Restrict method to retrieve Outlook mail items from a folder
In cases when you need to check multiple folders you may choose the AdvancedSearch method of the Application class. The key benefits of using the AdvancedSearch method in Outlook are:
The search is performed in another thread. You don’t need to run another thread manually since the AdvancedSearch method runs it automatically in the background.
Possibility to search for any item types: mail, appointment, calendar, notes etc. in any location, i.e. beyond the scope of a certain folder. The Restrict and Find/FindNext methods can be applied to a particular Items collection (see the Items property of the Folder class in Outlook).
Full support for DASL queries (custom properties can be used for searching too). To improve the search performance, Instant Search keywords can be used if Instant Search is enabled for the store (see the IsInstantSearchEnabled property of the Store class).
You can stop the search process at any moment using the Stop method of the Search class.
See Advanced search in Outlook programmatically: C#, VB.NET for more information.
In case if you need to search items for a specific date range, the Filtering Items Using a Date-time Comparison page describes formats of filtering strings. For example:
Dim datStartUTC As Date
Dim datEndUTC As Date
datStartUTC = oPA.LocalTimeToUTC(Date)
datEndUTC = oPA.LocalTimeToUTC(DateAdd("d", 1, Date))
'This filter uses urn:schemas:httpmail namespace
strFilter = AddQuotes("urn:schemas:httpmail:datereceived") _
& " > '" & datStartUTC & "' AND " _
& AddQuotes("urn:schemas:httpmail:datereceived") _
& " < '" & datEndUTC & "'"
'This call succeeds with #SQL prefix
Set colRestrict = colItems.Restrict("#SQL=" & strFilter)
'Get count of restricted items
Debug.Print (colRestrict.Count)
And a small function function to add quotes in VBA:
Public Function AddQuotes(ByVal SchemaName As String) As String
On Error Resume Next
AddQuotes = Chr(34) & SchemaName & Chr(34)
End Function
I am relatively new to writing VB scripts. Essentially, I need to get a functioning VB script to send an email to multiple recipients which vary each email. I need it to have Subject Line, Email Body, Attachment and flexibility to add multiple recipients in the TO, CC and BCC fields without adding individual lines of Add.Recipient for each email address in the TO field. Does anyone have any suggestions or know of any resources to find this information?
I have looked myself and coming up somewhat blank on it. I have the arguments set in a seperate.txt file. These will vary constantly. I am trying to do this as quickly but efficiently as possible.
I also have not had much luck with the Add.CC command so I took it out for this example...Below is what I currently have written out,
Set args = WScript.Arguments
arg1 = args.Item(0)
arg2 = args.Item(1)
arg3 = args.Item(2)
ToAddress = ""&arg1&""
CCAddress = ""&arg2&""
MessageSubject = "Your Order"
MessageBody = "Please find your Order Attached"
MessageAttachment = ""&arg3&""
Set ol = WScript.CreateObject("Outlook.Application")
Set ns = ol.getNamespace("MAPI")
Set newMail = ol.CreateItem(olMailItem)
newMail.Subject = MessageSubject
newMail.Body = MessageBody & vbCrLf & MyTime
newMail.RecipIents.Add(ToAddress)
newMail.Attachments.Add(MessageAttachment)
newMail.Send
I have the arguments written out as:
cscript //nologo test1.vbs email1#email.com email2#email.com y:\folder\test.txt
'Get email addresses, the -2 ignores the attachment
For x = 0 to WScript.Arguments.Count - 2
Msgbox Wscript.Arguments(x) & "Count " & x
Next
Msgbox Wscript.Arguments(wscript.arguments.count - 1) & " Attachment"
In programming we mostly use procedural steps, as you do. However very frequently we need to do loops. Because we wanted all but the last and then the last I used a For x = loop. For Each loops are usually better and cleaner code.
This prints out all arguments
For each Ag in WScript.Arguments
Msgbox Ag
Next
I have a form bound to a query, except for one field that I am leaving unbound. The idea is that the user will enter a value in that textbox and press a button to bring up the record. I have some code that I thought would work based on the interwebs. When I use DoCmd.ApplyFilter(filter_string) I get a popup asking for the value to filter on (which is not what I want). When I go ahead and paste it in, the form does not get filled. When I use Me.Form.Filter = filter_string, sometimes the form fills, but always with the same record, regardless of what the filter_string says. An example filter_string is
filter_string = "InventoryDetailsID = 'B01MFC000100/01'"
I have another similar form that, instead of filling with an existing query, generates the query (with 5 joins) and fills the form from the resulting recordset. It works just fine, but is slow because it has to run the query each time. That is why I want to use a method where I generate the query once, and then filter it.
Edit
Oh, and I also tried using a variant on the run-the-query-every-time approach, where I query the already generated query (the one I'm trying to filter). I'm using:
query_string = "SELECT * FROM qry_ISBN_All WHERE InventoryDetailsID LIKE '" & Me.InventoryDetailsID & "';"
But I get the error Run-time error '3061' Too few parameters, expected 1
Edit II
Private Sub btn_Seek_Click()
Dim temp As String
filter_string = "InventoryDetailsID = '" & Me.InventoryDetailsID & "'"
Me.temp = filter_string
Me.FilterOn = True
Me.Form.Filter = filter_string
Me.FilterOn = True
'DoCmd.ApplyFilter (filter_string)
' Dim query_string As String
' query_string = "SELECT * FROM qry_ISBN_All WHERE InventoryDetailsID LIKE '" & Me.InventoryDetailsID & "';"
End Sub
Typical filter string is given. It is printed to the form control Me.temp.
After this line:
Me.Filter = filter_string
Add this in:
Me.FilterOn = True
Also I agree, run the query every time approach is definitely overkill. The filter should provide you with the functionality you seek. You just simply have to "turn it on" after you set it.
I found a similar question that asks how to get a value of a WebElement and put it in an excel file and then e-mail the excel file, but how do I put that value of a WEbElement in the body of an e-mail in the middle of a sentence and NOT in an excel file?
For example, I want to capture a WebElement that tells me how many coke points I have and then I want to e-mail myself that value. Something like: "You have 500 Coke Points now".
This is what I have, but i'm getting a syntax error:
Dim ResultsFile
Set objOutlook=CreateObject("Outlook.Application")
Set objOutlookMsg=objOutlook.CreateItem(olMailItem)
objOutlookMsg.To="email#email.com"
ResultsFile="C:\Documents and Settings\Administrator\My Documents\CkeZeroPoints.xlsx"
objOutlookMsg.Subject="Coke Zero points"
objOutlookMsg.Body="You now have" &Browser("Sweepstakes.*").Page("Sweepstakes.*").WebElement("htmlID:=glPointsText").GetRoProperty("innertext") "Coke Zero points."
objOutlookMsg.Attachments.Add(ResultsFile)
objOutlookMsg.Display
objOutlookMsg.Send
Set objOutlookMsg=Nothing
Set objOutlook=Nothing
The syntax error starts on line 7.
Thank you in advance.
You forgot an ampersand (&):
Dim ResultsFile, innerText
Set objOutlook=CreateObject("Outlook.Application")
Set objOutlookMsg=objOutlook.CreateItem(olMailItem)
' Better to separate tasks so you can trap errors earlier
innerText = Browser("Sweepstakes.*").Page("Sweepstakes.*").WebElement("htmlID:=glPointsText").GetRoProperty("innertext")
ResultsFile = "C:\Documents and Settings\Administrator\My Documents\CkeZeroPoints.xlsx"
' email handling here, you can refactor this in a separate method
objOutlookMsg.To ="email#email.com"
objOutlookMsg.Subject = "Coke Zero points"
objOutlookMsg.Body = "You now have " & innerText & " Coke Zero points." ' <-- ampersand added on this line.
objOutlookMsg.Attachments.Add ResultsFile ' <-- parenthesis removed, only us parenthesis if
' you are calling a (returning) function
objOutlookMsg.Display
objOutlookMsg.Send
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
Please can you check this script? I can not get it to work - I would like to use this to send the same e-mail to different addresses but with a personalised greeting.
— Script requires two files placed in the same folder as the script.
— “Email Addresses.txt" should contain email addresses separated by a carriage return.
— “Email Message.txt" should contain the Subject on the first line then the message body below (seperated by a carriage return).
— Get path to script where the support files should be stored.
set myPath to (path to me) as text
set oldDelims to AppleScript's text item delimiters
set AppleScript's text item delimiters to ":"
set textChunks to text items of myPath
if last item of textChunks is "" then set textChunks to _chopLast(tectChunks)
set myFolderPath to _chopLast(textChunks) as text
set AppleScript's text item delimiters to oldDelims
log myPath
log myFolderPath
tell application "Finder"
-- Get the list of recipients
set recFile to (myFolderPath & ":Email Addresses.txt")
set recList to ""
set recFileID to (open for access (recFile as alias))
-- Extract text from the file
try
set fileLength to (get eof recFileID)
set recList to (read file recFile from 1 to (fileLength))
on error error_message number error_number
display alert "Error number: " & (error_number as string) & return ¬
& ("Message: ") & error_message
close access recFileID
end try
log recList
-- Get the email subject and body
set msgFile to (myFolderPath & ":Email Message.txt")
set msgFileID to (open for access (msgFile as alias))
-- Extract text from the file
try
set fileLength to (get eof msgFileID)
set emailBody to (read file msgFile from 1 to (fileLength))
on error error_message number error_number
display alert "Error number: " & (error_number as string) & return ¬
& ("Message: ") & error_message
close access msgFileID
end try
log emailBody
-- Seperate Subject from Body
set emailSubject to the first paragraph of emailBody
log emailSubject
set emailMsg to paragraphs 2 thru (count of paragraphs in emailBody) of emailBody
log emailMsg
set recListList to paragraphs in recList
-- Loop for each address.
repeat with eachAddress in (recListList)
set txtURL to ("mailto:" & eachAddress & "?subject=" & emailSubject & "&body=" & emailMsg as string)
open location txtURL
tell application "Mail"
activate
-- Uncomment the following line if you want to automatically send messages
-- send newMessage
end tell
end repeat
end tell
on _chopLast(theList)
return reverse of (rest of (reverse of theList))
end _chopLast
set addresses to "aa#example.com
bb#example.com"
set title to "title"
set body to "body"
--set body to read "/Users/username/Documents/body.txt" as «class utf8»
repeat with a in paragraphs of addresses
tell application "Mail"
activate
tell (make new outgoing message)
set visible to true
make new recipient at end of to recipients with properties {address:a}
set subject to title
set content to body
--send
end tell
end tell
end repeat