I have a script found on https://www.crestwood.com/2018/08/17/automating-outlook-calendar-to-send-daily-agenda/. This works but I can not control the details of the calendar. Or more correctly I can't figure out how to send Meeting subject and Location.
Is there a way with this code? Or could I go about it in some other way?
When doing it manually in Outlook it is called "Limited details" - this is my desired outcome.
I can change the constant: olFreeBusyAndSubject between 0, 1, 2. But none of these return my desired outcome. They result in (only seeing busy/free, Only seeing subject, Full details including description of event). I do not want full details since their might be sensitive information which I do not want on my secondary e-mail.
' -------------------------------------------------
' Modify this \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Const myEmailAddress = "some#email.com"
Const includePrivateDetails = TRUE
Const howManyDaysToDisplay = 1
' Modify this /////////////////////////////////////
' -------------------------------------------------
Const olCalendarMailFormatDailySchedule = 0
Const olFreeBusyAndSubject = 2
' Const olFullDetails = 1
Const olFolderCalendar = 9
SendCalendar myEmailAddress, Date, (Date + (howManyDaysToDisplay - 1))
Sub SendCalendar(strAdr, datBeg, datEnd)
Dim olkApp, olkSes, olkCal, olkExp, olkMsg
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = OlkApp.GetNameSpace("MAPI")
olkSes.Logon olkApp.DefaultProfileName
Set olkCal = olkSes.GetDefaultFolder(olFolderCalendar)
Set olkExp = olkCal.GetCalendarExporter
With olkExp
.CalendarDetail = olFreeBusyAndSubject
.IncludePrivateDetails = includePrivateDetails
.RestrictToWorkingHours = False
.StartDate = datBeg
.EndDate = datEnd
End With
Set olkMsg = olkExp.ForwardAsICal(olCalendarMailFormatDailySchedule)
With olkMsg
.To = strAdr
.Send
End With
Set olkCal = Nothing
Set olkExp = Nothing
Set olkMsg = Nothing
olkSes.Logoff
Set olkSes = Nothing
Set olkApp = Nothing
End Sub
As described desired outcome is to thorugh a VBA-script (or other automated way) send "Limited details"-Outlook-calendar by e-mail.
Thank you in advance!
In .CalendarDetail = olFreeBusyAndSubject replace olFreeBusyAndSubject by olFullDetails.
To discover this I used Bing and searched for "Outlook CalendarDetail". I find this an easy method for discovering the permitted values for a property.
Related
I'm brand spanking new to VBA. But I've programmed a bit in SAS, just a bit in Assembler (mainframe and PC), Word Perfect (macros), a bit in Java, HTML, other stuff. What I do is, when I have a problem and I think I can program it, I look for code on the internet and adjust it to fit my needs. I have read a little bit of VBA programming. What I'm trying to do is make a macro to save a bunch of Outlook e-mail messages with PDFMAKER. I've come up with the below, so far. When I step the program, pmkr2 gets assigned type "ObjectPDFMaker" and stng gets assigned type "ISettings". So far, so good. Then I try to set stng and can't do it. I get the error "Method or data member not found." If I get rid of Set it highlights .ISettings and I get the same error. I go into F2 and the AdobePDFMakerforOffice library is there, and the class ISettings is there, but I can't seem to set stng. I'm wa-a-a-ay frustrated. Please help.
Sub ConvertToPDFWithLinks()
Dim pmkr2 As Object
Set pmkr2 = Application.COMAddIns.Item(6).Object ' Assign object reference.
Dim pdfname As String
pdfname = "C:\stuff\stuff\tester.pdf"
Dim stng As AdobePDFMakerForOffice.ISettings
Set stng = AdobePDFMakerForOffice.ISettings
stng.AddBookmarks = True
stng.AddLinks = True
stng.AddTags = True
stng.ConvertAllPages = True
stng.CreateFootnoteLinks = True
stng.CreateXrefLinks = True
stng.OutputPDFFileName = pdfname
stng.PromptForPDFFilename = False
stng.ShouldShowProgressDialog = True
stng.ViewPDFFile = False
pmkr.GetCurrentConversionSettings stng
pmkr2.CreatePDFEx stng, 0
Set pmkr2 = Nothing ' Discontinue association.
End Sub
I updated your code a little. See if this has any affect:
Sub ConvertToPDFWithLinks()
Dim pmkr2 As AdobePDFMakerForOffice.PDFMaker
'Set pmkr2 = Application.COMAddIns.Item(6).Object ' Assign object reference.
Set pmkr2 = Nothing
For Each a In Application.COMAddIns
If InStr(UCase(a.Description), "PDFMAKER") > 0 Then
Set pmkr2 = a.Object
Exit For
End If
Next
If pmkr2 Is Nothing Then
MsgBox "Cannot Find PDFMaker add-in", vbOKOnly, ""
Exit Sub
End If
Dim pdfname As String
pdfname = "C:\stuff\stuff\tester.pdf"
Dim stng As AdobePDFMakerForOffice.ISettings
pmkr2.GetCurrentConversionSettings stng
stng.AddBookmarks = True
stng.AddLinks = True
stng.AddTags = True
stng.ConvertAllPages = True
stng.CreateFootnoteLinks = True
stng.CreateXrefLinks = True
stng.OutputPDFFileName = pdfname
stng.PromptForPDFFilename = False
stng.ShouldShowProgressDialog = True
stng.ViewPDFFile = False
pmkr2.CreatePDFEx stng, 0
Set pmkr2 = Nothing ' Discontinue association.
End Sub
The main changes were in how the addin is obtained and in how stng is created.
I am creating a VBA Macro in Outlook that will copy an existing meeting invite and create a follow up meeting invite. It should be fairly easy since I have all the parts to this puzzle.
My problem is with the body of the invite; all formatting and pictures are lost. For this reason, I need to use the Word Inspector object to preserve any special formatting and images. I figured out the code using Word and recording a macro.
So I have figured out the code for copying text using the Word Inspector, but I am not sure on how to paste it in another invite.
Sub copyPaste()
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
On Error Resume Next
Set objOL = Application
If objOL.ActiveInspector.EditorType = olEditorWord Then
Set objDoc = objOL.ActiveInspector.WordEditor
Set objNS = objOL.Session
Set objSel = objDoc.Windows(1).Selection
objSel.WholeStory
objSel.Copy
objSel.PasteAndFormat (wdFormatOriginalFormatting)
End If
Set objOL = Nothing
Set objNS = Nothing
End Sub
Please see my current Outlook code:
Sub scheduleFollowUpMeeting()
'Declarations
Dim obj As Object
Dim Sel As Outlook.Selection
'Selecting the Email
If TypeOf Application.ActiveWindow Is Outlook.Inspector Then
Set obj = Application.ActiveInspector.currentItem
Else
Set Sel = Application.ActiveExplorer.Selection
If Sel.Count Then
Set obj = Sel(1)
End If
End If
If Not obj Is Nothing Then
MsgBox "The original meeting has been copied." & vbCrLf & "Please kindly update any new details like date/time.", , "Follow Up Meeting - Amit P Shah"
Dim objFollowUp As Outlook.AppointmentItem
Set objFollowUp = Application.CreateItem(olAppointmentItem)
'Copies existing details from original Invite
With objFollowUp
.MeetingStatus = olMeeting
.Subject = "Follow Up: " & obj.Subject
.Body = obj.Body
.Start = Now + 1 'Takes today's date and adds 1 day
.End = DateAdd("n", obj.Duration, .Start)
'Other
.AllDayEvent = obj.AllDayEvent
.BusyStatus = obj.BusyStatus
.Categories = obj.Categories
.Companies = obj.Companies
.ForceUpdateToAllAttendees = obj.ForceUpdateToAllAttendees
.Importance = obj.Importance
.Location = obj.Location
.OptionalAttendees = obj.OptionalAttendees
.ReminderMinutesBeforeStart = obj.ReminderMinutesBeforeStart
.ReminderOverrideDefault = obj.ReminderOverrideDefault
.ReminderPlaySound = obj.ReminderPlaySound
.ReminderSet = obj.ReminderSet
.ReminderSoundFile = obj.ReminderSoundFile
.ReplyTime = obj.ReplyTime
.RequiredAttendees = obj.RequiredAttendees
.Resources = obj.Resources
.ResponseRequested = obj.ResponseRequested
.Sensitivity = obj.Sensitivity
.UnRead = obj.UnRead
.Display
End With
End If
End Sub
Any help would greatly be appreciated. Many thanks in advance!
I'm not a specialist on this subject but i used to work and manipulate Outlook's AppointmentItem in C# and that's how i see the thing.
Actually, if you try to copy the body of a meeting on another meeting, like you said, you will lose all the special formating, images, etc.
The new body will only contain the caracters without format.
I think you can't put formatted text on the body property, you have to use the rtfbody property or like you did when you copy the body of your original appointment, use the WordEditor property in the Inspector object.
So, try to use the WordEditor of the new Item you're creating (like you did to take the original content) and to add content in it.
That's what i had to do for putting formatted text in the body of an AppointmentItem in C#.
I did something like that :
Word.Document myDoc = myItem.GetInspector.WordEditor;
Word.Paragraphs paragraphs = myDoc.Content.Paragraphs;
Word.Paragraph para = paragraphs.Add();
para.Range.Text = yourFormattedTextHere;
After that, you may need to release the variables created, but i'm not sure about that.
I have a function that find a specific mail with subject, i also want to add some methods to find out if the mail has a valid digital signature.
Set objOutlook = CreateObject("Outlook.Application")
Set myNameSpace = objOutlook.GetNameSpace("MAPI")
Set ClientFolder = myNameSpace.GetDefaultFolder(6) 'Inbox = 6
Set myItems = ClientFolder.Items
Set myItem = myItems.GetFirst
Set colSyc = myNameSpace.SyncObjects
Set syc = colSyc.AppFolders
ClientFolder.InAppFolderSyncObject = True
syc.Start 'Sync inbox at most updated state
For intMailCount = 0 to ClientFolder.Items.Count - 1 ' Check subject line for a match
If Instr(myItem.Subject, Subject) = 1 AND myItem.Unread = True then
VerifyEmailSubject = "True"
'validation under here does not work properly and allways returns true and need to find something here for validation
If myItem.MessageClass <> "IPM.Note.SMIME" Or myItem.MessageClass <> "IPM.Note.Secure" Or myItem.MessageClass <> "IPM.Note.Secure.Sign" then
msgbox "signed"
End If
myItem.Unread = false 'Set mail status to read to avoid further test assertion errors.
Exit For
End If
Set myItem = myItems.GetNext
Next
Solved
If myItem.MessageClass = "IPM.Note.SMIME.MultipartSigned" Then
VerifyEmailSignature = "True"
End If
My VBA experience is incredibly limited.I have created basic macros for excel primarily by frankensteining multiple macros I find online together.
Here's what I am looking to do. Every morning I send out an email to a list of 200 customers, I open the new message from a list and the message auto populates (as it is a signature). Currently I then go through all these emails and add my subject and BCC. Could I possibly create a macro to open all of these emails, add my BCC, add my subject, and then send the emails.
Any and all help is much appreciated.
The following code defines an instance of Outlook.Application, and sets up a MailItem ready for sending. It uses a Dictionary object called EmailData to hold the various bits of info to populate To, BCC etc but those can be replaced with your own strings etc. I've pulled this from a function I wrote and made it a little more generic:
Public Function OL_SendMail()
Dim bOpenedOutlook, sComputer, iLoop, iAccount, sAttachArray, sAttachment
bOpenedOutlook = False
sComputer = "."
Dim oWMIService : Set oWMIService = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")
Dim colItems : Set colItems = oWMIService.ExecQuery ("Select * from Win32_Process Where Name = 'outlook.exe'")
Dim oOutlook : Set oOutlook = CreateObject("Outlook.Application")
Dim oNamespace : Set oNamespace = oOutlook.GetNamespace("MAPI")
If colItems.Count = 0 Then
' Outlook isn't open, logging onto it...
oNamespace.Logon "Outlook",,False,True
bOpenedOutlook = True
End If
Dim oFolder : Set oFolder = oNamespace.GetDefaultFolder(olFolderInbox)
If EmailData("SendFrom") = "" Then
' default to first email account the user has access to
iAccount = 1
Else
' Checking to see if the account to send from is accessible by this user...
iAccount = 0
For iLoop = 1 To oOutlook.Session.Accounts.Count
If UCase(Trim(oOutlook.Session.Accounts.Item(iLoop))) = UCase(Trim(EmailData("SendFrom"))) Then
iAccount = iLoop
Exit For
End If
Next
If iAccount = 0 Then
sErrorMsg = "Cannot send email from specified account: " & EmailData("SendFrom") & " as this user doesn't appear to have access to it in Outlook!"
OL_SendMail = False
Exit Function
End If
End If
Dim oMailItem : Set oMailItem = oOutlook.CreateItem(olMailItem)
With oMailItem
Set .SendUsingAccount = oOutlook.Session.Accounts.Item(iAccount)
.To = EmailData("To")
.CC = EmailData("CC")
.BCC = EmailData("BCC")
.Subject = EmailData("Subject")
.Body = EmailData("Body")
sAttachArray = Split(EmailData("AttachmentPaths"), ";")
For Each sAttachment In sAttachArray
.Attachments.Add(sAttachment)
Next
.Recipients.ResolveAll
.Display ' debug mode - uncomment this to see email before it's sent out
End With
'Mail Item created and ready to send
'oMailItem.Send ' this is commented out so the mail doesn't auto send, allows checking of it!!
Set oMailItem = Nothing
Set oNamespace = Nothing
If bOpenedOutlook Then
'oOutlook.Quit
End If
Set oOutlook = Nothing
Set colItems = Nothing
Set oWMIService = Nothing
OL_SendMail = True
End Function
I need to know how to move all of the messages in a conversation at once.
My macro currently reads
Sub Archive()
Set ArchiveFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders("Archive")
For Each Msg In ActiveExplorer.Selection
Msg.UnRead = False
Msg.Move ArchiveFolder
Next Msg
End Sub
But that only moves the latest message... and only when the conversation is fully collapsed! I can't Archive when the conversation is expanded.
Paul-Jan put me on the right path, so I gave him the answer. Here's my really poor VBA version (I'm missing some type casting, checking). But it does work on collapsed and expanded conversations of mail.
Sub ArchiveConversation()
Set ArchiveFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders("Archive")
Set Conversations = ActiveExplorer.Selection.GetSelection(Outlook.OlSelectionContents.olConversationHeaders)
For Each Header In Conversations
Set Items = Header.GetItems()
For i = 1 To Items.Count
Items(i).UnRead = False
Items(i).Move ArchiveFolder
Next i
Next Header
End Sub
Anthony's answer almost works for me. But it doesn't work on both messages and conversations. Here's my modification:
Sub Archive()
Set ArchiveFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders("Archive")
Dim IsMessage As Integer
IsMessage = 0
For Each Msg In ActiveExplorer.Selection
Msg.Move ArchiveFolder
IsMessage = 1
Next Msg
If IsMessage = 0 Then
Set Conversations = ActiveExplorer.Selection.GetSelection(Outlook.OlSelectionContents.olConversationHeaders)
For Each Header In Conversations
Set Items = Header.GetItems()
For i = 1 To Items.Count
Items(i).UnRead = False
Items(i).Move ArchiveFolder
Next i
Next Header
End If
End Sub
If you want to handle conversations, you'll have to do so explicitly. You can go from MailItem to its Conversation using MailItem.GetConversation, but you'd be better off working with conversations directly.
What you do is:
Get all conversation headers from the current selection
For each conversation, get the individual items
Do your archiving thing with them.
The following C# code illustrates this, and should be trivial to port to VBA.
Outlook.Selection selection = Application.ActiveExplorer().Selection;
Outlook.Selection convHeaders = selection.GetSelection( Outlook.OlSelectionContents.olConversationHeaders) as Outlook.Selection;
foreach (Outlook.ConversationHeader convHeader in convHeaders)
{
Outlook.SimpleItems items = convHeader.GetItems();
for (int i = 1; i <= items.Count; i++)
{
if (items[i] is Outlook.MailItem)
{
Outlook.MailItem mail = items[i] as Outlook.MailItem;
mail.UnRead = false;
mail.Move( archiveFolder );
}
// else... not sure how if you want to handle different types of items as well }
}