I wanted to add multiple lines to the body of a mail using VB. Below the code for openining and formatting the mail:
With Workbooks("HEelo world.xlsx").Worksheets("Hello")
mail.To = .Range(.Range("F:F").Find("Address1").Address).Offset(0, 1)
mail.Cc = .Range(.Range("F:F").Find("Address2").Address).Offset(0, 1)
mail.Subject = .Range(.Range("F:F").Find("Object").Address).Offset(0, 1)
mail.Body = .Range(.Range("F:F").Find("Body").Address).Offset(0, 1)
mail.Body = ....
End With
What is the correct syntax for adding multiple lines?
I found this which should work:
Dim strBody As String
strBody = .Range(.Range("B:B").Find("text1").Address).Offset(0, 1) & vbCrLf _
& .Range(.Range("B:B").Find("text2").Address).Offset(0, 1) & vbCrLf _
& .Range(.Range("B:B").Find("text3").Address).Offset(0, 1) & vbCrLf _
& .Range(.Range("B:B").Find("text4").Address).Offset(0, 1) & vbCrLf
mail.Body = strBody
Dummies Guide to naming Excel ranges
Use the link I've provided to learn how to modify a range to have a Name. You can target a range as a named reference in your vba. For this example we have called the cell range (eg.B4:B8) that contains the value for the mail body "BodyValue"
Dim strBody As String
strBody = ""
For Each cl in Range("BodyValue").Cells
strBody = cl.Value & vbCrLf
Next
mail.Body = strBody
You can do this for all parts used in your email as well so instead of using an Offset, name your cells or ranges and reference the names in your VBA. This will also avoid errors occuring if you add a row or column in any part of your sheet as named cells keep their name independant of changes to their address in the sheet.
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've looked up the following code from another question on this site and have tried to apply it to my own, to no avail - I am trying to email out a pdf of my report to each user with only their specific information contained therein. If there are 15 users, then there will be 15 different emails sent out containing only their info. any help is very much appreciated.
Option Compare Database
Sub Mac1()
Dim rsAccountNumber As DAO.Recordset
Set rsAccountNumber = CurrentDb.OpenRecordset( _
"SELECT DISTINCT AccountNumber FROM UnAffirmed_Report_for_En Query")
With rsAccountNumber
Do Until .EOF
DoCmd.OpenReport "Unaffirmed Report", _
acViewPreview, _
WhereCondition:="AccountNumber = " & !AccountNumber, _
WindowMode:=acHidden
DoCmd.OutputTo acOutputReport, _
"Unaffirmed Report", _
acFormatPDF, _
"C:\users\rv\folder_name" & !AccountNumber & ".pdf"
DoCmd.Close acReport, "Unaffirmed Report", acSaveNo
.MoveNext
Loop
.Close
End With
End Sub
when I do though, I receive Run-time error '3075':
Syntax error (missing operator) in query expression 'AccountNumber = 1RV80014'
the account # is valid, but not sure why I am getting stuck here or how to fix it - super newbe to this.
Your account number is a String 1RV80014 and your Where condition:="AccountNumber = " & !AccountNumber states an Integer. So change it to a String Where condition:= "AccountNumber = '" & !AccountNumber & "'"
I have an example search form query that I'd like to duplicate the output from in order to control an additional side query. I have two goals with this:
1) Send data to a report that matches the search results.
2) Be able to limit the columns that are being output to Excel - ie. exclude the search textboxes from the spreadsheet output (ie. hoping for detail section-only output).
To give a little bit more detail - this is going to be a read-only database and I'm trying to set this up to run in the background for the users so that they can have clean Excel exports and print exactly what they wish.
My code for the form search query looks like this:
Dim strWhere As String
Dim lngLen As Long
Const conJetDate = "\#mm\/dd\/yyyy\#"
If Not IsNull(Me.txtQ_ID) Then
strWhere = strWhere & "([Q_ID] = " & Me.txtQ_ID & ") AND "
End If
If Not IsNull(Me.txtAnswer) Then
strWhere = strWhere & "([Answer] Like """ & Me.txtAnswer & """) AND "
End If
If Not IsNull(Me.txtItem) Then
strWhere = strWhere & "([Item_Condition] Like """ & Me.txtItem & """) AND "
End If
If Not IsNull(Me.txtComments) Then
strWhere = strWhere & "([Comments] Like """ & Me.txtComments & """) AND "
End If
lngLen = Len(strWhere) - 5
If lngLen <= 0 Then
MsgBox "Please enter search criteria.", vbInformation, "Nothing to do."
Else
strWhere = Left$(strWhere, lngLen)
Me.Filter = strWhere
Me.FilterOn = True
End If
Is there a clean way to get this to feed back into SQL? I've seen this possibility suggested in another thread but there wasn't enough detail to go on.
Thank you in advance!
Matt B
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 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.