VBA Excel create Outlook 2013 Appointment - vba

I am trying to create an Outlook Appointment with a Macro, I am having an issue with the code giving me an error of "Object Doesn't support this property or method" when it comes the Default Appointment Values. I have tried several fixes but am not experienced enough to resolve. Any assistance is greatly appreciated.
Here is what I am working with:
Sub CalendarInvite()
Dim olApp As Object
Dim olAppItem As Object
Dim r As Long
Set olApp = GetObject("", "Outlook.Application")
Dim mysub, myStart, myEnd
mysub = Range("Title")
myStart = Range("Date")
myEnd = Range("Date")
'creates a new appointment
Set olAppItem = olApp.CreateItem(olAppointmentItem)
'set default appointment values
With olAppItem
.Location = Range("Location")
.Body = Range("Body")
.ReminderSet = True
.BusyStatus = olFree
.RequiredAttendees = "email#email.com"
'saves the new appointment to the default folder
.Save
End With
Set olAppItem = Nothing
Set olApp = Nothing
End Sub

Set olAppItem = olApp.CreateItem(olAppointmentItem)
Assuming you're late-binding the Outlook library, the constant olAppointmentItem is not defined, so if you specify Option Explicit at the top of the module the VBE will highlight if as undeclared.
I copied your code into ThisWorkbook in an empty workbook, and ran Rubberduck code inspections (disclaimer: I manage that open-source project; it's completely free, and it's improving every day).
These results are particularly relevant to your problem:
Error: Option Explicit is not specified in 'ThisWorkbook' - (Book3) VBAProject.ThisWorkbook, line 1
Error: Variable 'olAppointmentItem' is used but not assigned - (Book3) VBAProject.ThisWorkbook, line 16
Error: Variable 'olFree' is used but not assigned - (Book3) VBAProject.ThisWorkbook, line 23
Error: Local variable 'olAppointmentItem' is not declared - (Book3) VBAProject.ThisWorkbook, line 16
Error: Local variable 'olFree' is not declared - (Book3) VBAProject.ThisWorkbook, line 23
The underlying value of olFree in the Outlook library is 0, so that's not a big deal as far as run-time errors are concerned.
However olAppointmentItem not being defined is pretty big: you think you're working against an AppointmentItem object, but because the underlying value of olAppointmentItem in the Outlook library is 1 and you're providing a 0, the runtime type of olAppItem is actually a MailItem.
And because a MailItem doesn't have a Location property, attempting to set it will raise that run-time error 438 you're getting - "object doesn't support this property or method".
Therefore, you should be creating the olAppItem like this:
Set olAppItem = olApp.CreateItem(1)
Or, define the olAppointmentItem constant:
Const olAppointmentItem As Long = 1
Set olAppItem = olApp.CreateItem(olAppointmentItem)
Or, reference the Outlook object model (Tools > References...), replace As Object with the actual types you want to be using (olApp As Outlook.Application, olAppItem As AppointmentItem), and then the olAppointmentItem and olFree constants will be taken from the Outlook library.
I'll skip the other inspection results because they're not relevant to that specific question, but you'll notice a number of dead variables there.

If you want to create an appointment in Outlook, using Excel, run the script below.
Private Sub Add_Appointments_To_Outlook_Calendar()
'Include Microsoft Outlook nn.nn Object Library from Tools -> References
Dim oAppt As AppointmentItem
Dim Remind_Time As Double
i = 2
Subj = ThisWorkbook.Sheets(1).Cells(i, 1)
'Loop through entire list of Reminders to be added
While Subj <> ""
Set oAppt = Outlook.Application.CreateItem(olAppointmentItem)
oAppt.Subject = Subj
oAppt.Location = ThisWorkbook.Sheets(1).Cells(i, 2)
oAppt.Start = ThisWorkbook.Sheets(1).Cells(i, 3)
Remind_Time = ThisWorkbook.Sheets(1).Cells(i, 4) * 1 * 60
oAppt.ReminderMinutesBeforeStart = Remind_Time
oAppt.AllDayEvent = True
oAppt.Save
i = i + 1
Subj = ThisWorkbook.Sheets(1).Cells(i, 1)
Wend
MsgBox "Reminder(s) Added To Outlook Calendar"
End Sub
' The code comes from this link:
http://officetricks.com/add-appointment-to-outlook-calendar-through-excel-macro-vba/
The script is run from Excel, and as such, you must set a reference to Outlook before you run the code. Also, notice that the worksheet needs to be setup properly for the script to run. It should look something like this. Everything is read from Excel into Outlook.

Related

How to select all text and change spelling language?

I need to select the entire text in the email I'm typing, and change the spelling language.
The following works in Word but doesn't in Outlook 2013.
I added Microsoft Word 15 Object library, with tools -> references, from the VBA editor window.
Selection.WholeStory
Selection.LanguageID = wdEnglishUK
Selection.NoProofing = False
Application.CheckLanguage = False
Methods and properties specific to one application's VBA language can't be used in other applications like that.
There is a lot of information out there, try a search for "Outlook VBA Change Message Body Language" and variations of that.
Some resources to get you started:
Stack Overflow: Outlook VBA Set language of selection
MSDN: Working with Item Bodies with Outlook/VBA
MSDN: MailItem Object (Outlook)
Stack Overflow: Display email body of selected email in Outlook as a message box in Excel
MSDN: Introduction to Outlook VBA
NoProofing should work as intended.
Option Explicit
Private Sub Proofing_EnglishUK()
Dim oMailItm As Object
Dim oInsp As Object
Dim oMailEd As Object
Dim oWord As Object
Dim Rng As Object
Set oInsp = ActiveInspector
If oInsp.currentItem.Class = olMail Then
Set oMailItm = oInsp.currentItem
If oInsp.EditorType = olEditorWord Then
Set oMailEd = oMailItm.GetInspector.WordEditor
Set oWord = oMailEd.Application
Set Rng = oWord.Selection
Rng.WholeStory
With Rng
.LanguageID = wdEnglishUK
' This should work as intended
'.NoProofing = False
' ******* temporary *************
' Check whether .NoProofing can be set
' with a spelling error somewhere in the mail
.NoProofing = Not .NoProofing
If .NoProofing = False Then
MsgBox "Proofing on. Errors should be found."
Else
MsgBox "Proofing off. The errors will not be found."
End If
' ******* temporary *************
End With
oMailItm.Save
End If
End If
Set Rng = Nothing
Set oWord = Nothing
Set oMailEd = Nothing
Set oMailItm = Nothing
End Sub

How to call Word macros from Excel

I have two macros, one in Excel, and one in Word. The Excel Macro calls the Word macro. My code is as follows:
Excel:
Public wb1 As Workbook
Public dt1 As Document
Sub openword()
Dim wpath, epath As String 'where the word document will be opened and where the excel sheet will be saved
Dim wordapp As Object 'preparing to open word
Set wb1 = ThisWorkbook
While wb1.Sheets.Count <> 1
wb1.Sheets(2).Delete
Wend
wpath = "C:\users\GPerry\Desktop\Projects and Work\document.docm"
Set wordapp = CreateObject("Word.Application")
'Set wordapp = CreateObject(Shell("C:\Program Files (x86)\Microsoft Office\Office14\WINWORD", vbNormalFocus)) this is one I tried to make work because while word.application seems to work, I don't *understand* it, so if anyone can help, that'd be awesome
wordapp.Visible = True
Set dt1 = wordapp.Documents.Open(wpath)
wordapp.Run "divider", wb1, dt1
dt1.Close
wordapp.Quit
End Sub
And word:
Sub divider(wb1, dt1)
Set dt1 = ThisDocument
If dt1.Paragraphs.Count > 65000 Then
Set cutrange = dt1.Range(dt1.Paragraphs(1).Range.Start, dt1.Paragraphs(65000).Range.End)
If wb1.Sheets(Sheets.Count).Cells(1, 1) <> "" Then
wb1.Sheets.Add After:=Sheets.Count
End If
Else
Set cutrange = dt1.Content
If wb1.Sheets(Sheets.Count).Cells(1, 1) <> "" Then
wb1.Sheets.Add After:=Sheets.Count
End If
End If
cutrange.Cut Destination:=wb1.Sheets(wb1.Sheets(Sheets.Count)).Cells(1, 1)
wb1.Sheets(Sheets.Count).Cells(1, 1).TextToColumns Destination:=wb1.Sheets(1).Cells(1, 1)
End Sub
My problem is that the variable wb1 isn't getting passed between them. Even though I put wb1 in the list of variables to send to the macro, when it arrives at the document, wb1 has no value inside of it. I would re-initialize it, but I don't know how to refer to an already existing document - only how to set it equal to one as you open it.
So either how do I pass the value through into the Word macro, or how do I re-initialize this variable? Preferably without having to set something equal to the excel application, because every time I try that it sets it equal to Excel 2003, not 2010 (though any solutions to that are also, of course, welcome).
Thanks!
You can't use the Excel global objects from inside of Word without explicitly qualifying them (they simply don't exist there). In particular, that means you can't use Sheets. You should also explicitly declare the variable types of your parameters - otherwise they'll be treated as Variant. This is important with reference types because in that it helps prevent run-time errors because the compiler knows that the Set keyword is required.
Sub divider(wb1 As Object, dt1 As Document)
Set dt1 = ThisDocument
If dt1.Paragraphs.Count > 65000 Then
Set cutrange = dt1.Range(dt1.Paragraphs(1).Range.Start, dt1.Paragraphs(65000).Range.End)
If wb1.Sheets(wb1.Sheets.Count).Cells(1, 1) <> "" Then
wb1.Sheets.Add After:=wb1.Sheets.Count
End If
Else
Set cutrange = dt1.Content
If wb1.Sheets(wb1.Sheets.Count).Cells(1, 1) <> "" Then
wb1.Sheets.Add After:=wb1.Sheets.Count
End If
End If
cutrange.Cut Destination:=wb1.Sheets(wb1.Sheets(wb1.Sheets.Count)).Cells(1, 1)
wb1.Sheets(wb1.Sheets.Count).Cells(1, 1).TextToColumns Destination:=wb1.Sheets(1).Cells(1, 1)
End Sub
Note - you also don't need to pass dt1 at all. You never use the value in the parameter and actually set it to something else. This could be a source of errors if you're using internal calls, because dt1 is implicitly passed ByRef (it gets boxed when you call it through Application.Run). That means whenever you call divider, whatever you pass to dt1 in the calling code will change to ThisDocument. You should either remove the parameter or specify that it is ByVal.
Borrowed from another SO link.
Sub Sample()
Dim wdApp As Object, newDoc As Object
Dim strFile As String
strFile = "C:\Some\Folder\MyWordDoc.dotm"
'~~> Establish an Word application object
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0
wdApp.Visible = True
Set newDoc = wdApp.Documents.Add(strFile)
Call wdApp.Run("YHelloThar", "Hello")
'
'~~> Rest of the code
'
End Sub

Finding the LastRow from Excel Attachment via Outlook VBA

I've been searching for an answer to this particular issue but I can't seem to find one. I am trying to combine multiple Excel-based lists that I receive as e-mail attachments. Just to give a little context, this macro has been working for almost two years without error but I recently switched it from a system running Excel 2007 & Outlook 2010 to a system running Excel 2007 & Outlook 2007.
The following line is giving me an 1004: Application-defined or object-defined error:
LR = xlAtt.ActiveSheet.Range("A" & xlAtt.ActiveSheet.Rows.Count).End(xlUp).Row
in context the code is:
Private Sub ProcessAttachments(olFolder As Outlook.MAPIFolder)
Dim xlApp As Object, xlAtt As Object
Dim LR As Long
Dim olItem As Outlook.MailItem
Dim count As Integer
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
For count = olFolder.Items.Count To 1 Step -1
Set olItem = olFolder.Items.Item(count)
If olItem.Class = olMail And olItem.Attachments.Count > 0 Then
'Omitted a few lines here that verify if the attachment is an Excel file
'and then saves it to a folder
Set xlAtt = xlApp.Workbooks.Open("pathToFile")
xlAtt.Activate
LR = xlAtt.ActiveSheet.Range("A" & xlAtt.ActiveSheet.Rows.Count).End(xlUp).Row
'More VBA after
The above is just a snippet of the code but hopefully gives enough context.
I have tried testing each individual piece of the line giving me an error and I've been able to narrow it down to the .End(xlUp).Row portion of the line.
Any help is appreciated.
Outlook 2007 must not recognize the Excel Constants, whereas OL 2010 does.
Instead of writing xlUp write the enumeration for xlUp which is -4162.
So your code would look like this:
LR = xlAtt.ActiveSheet.Range("A" & xlAtt.ActiveSheet.Rows.Count).End(-4162).Row
To find any enumeration for any constant in Excel VBA, once inside the VBE, press F2 to open the Object Browser and type the constant into the box next to the binoculars, then click the binocular. Click on the constant in the search results and the box at the bottom will show the enumeration.
Alternatively, you could set a constant variable to the enumeration and still use xlUp in your syntax by:
Constant xlUp = -4162

Outlook Object Library Does Not Switch Between Versions 12 And 14

I have a .dotm template file on a network share. There are macros with references to the Word, Office, and Outlook object libraries. We use two different platforms, Windows XP and Windows 7, along with Microsoft Office 2007 and Office 2010. When users open the template file the references for Word and Office adjust automatic and accordingly (that is, they’re set to Microsoft Word 12 Object Library or Microsoft Word 14 Object Library as needed), and the macros run without a problem.
Microsoft Outlook Object Library switches properly from version 12 to 14. It does not switch properly from version 14 to 12. In that case, it gives the error that the libary is not found. Is this a bug? Is there a workaround? Something I’m overlooking?
ForEachLoop,
It appears that your question has largely been answered. I will merely add a bit of information for clarity's sake, and to provide this question with an answer. A user on the Microsoft Forums, Ossiemac, noted that LateBinding was the way to go, as has been stated by Siddarth Rout. As implied by Siddarth, that means you do not have to worry about references.
Ossiemac provided some sample code for using the LateBinding in the sending of an email, which I have reformatted and placed here:
Private Sub btnLateBindMethod_Click()
' Variables used for LateBinding
Dim objOutlook As Object 'Outlook.Application
Dim objEmail As Object 'Outlook.MailItem
Dim objNameSpace As Object 'Outlook.NameSpace
Const OutLookMailItem As Long = 0 'For Late Binding
Const OutLookFolderInbox As Long = 6 'For Late Binding
Const OutLookFormatHTML As Long = 2 'For Late Binding
Dim strSubject As String
Dim strAddress As String
On Error Resume Next
Set objOutlook = GetObject(, "Outlook.Application")
On Error GoTo 0
If objOutlook Is Nothing Then
Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
objNameSpace.GetDefaultFolder(OutLookFolderInbox).Display
End If
Set objEmail = objOutlook.CreateItem(OutLookMailItem)
strSubject = "Hello World"
With objEmail
'.To = strToAddress 'Commented to prevent accidental send
.Subject = strSubject
.BodyFormat = OutLookFormatHTML
.Display
'Full Name of window can change depending on Tools -> Options -> Mail Format
'Changing this option for outgoing mail changes the window name.
'However, AppActivate appears not to require entire name but needs up to end
'of - Message which is included in heading following the Subject string
'irrespective of the Mail Format option chosen.
AppActivate (strSubject & " - Message")
End With
End Sub
Jimmy Pena has an article discussing the contrast of EarlyBinding and LateBinding -
~JOL

Determining whether an existing Outlook instance is open

After reading how to use automation to send a message, I'm unclear of whether it's possible to avoid opening a new instance of Outlook if I already have one opened. If so, I'm unsure of how to search for examples determining whether an existing Outlook instance is open.
-----Including the suggestion--------
I have the following snippet, but I found that I can't create the instance properly. I'm basically following this example. I'm either getting this screenshot, or the error of "User-defined type not defined." Any suggestions?
Sub Example()
'Dim w As Outlook.Application
Const ERR_APP_NOTRUNNING As Long = 429
On Error Resume Next
' Handle Microsoft outlook
Set w = GetObject(, "Outlook.Application")
If Err = ERR_APP_NOTRUNNING Then
'Set w = New Outlook.Application
Set w = CreateObject("Outlook.Application")
End If
End Sub
I know this question has been answered, but I thought I'd add that applications like Outlook (and I believe PowerPoint as well) are single-instance applications -- there is no need to determine if Outlook is already open because you can only have one copy of Outlook running.
http://msdn.microsoft.com/en-us/library/aa164542(v=office.10).aspx
If you need to instantiate Outlook, simply use CreateObject to create the instance; if Outlook is already running, your object reference will point to the existing instance. If not, you will create the class. Binding (late or early) is irrelevant.
For example, let's say Outlook isn't running. We can use this code to create the instance:
Sub testOutlook()
Dim olApp As Object ' Outlook.Application
Set olApp = CreateObject("Outlook.Application")
MsgBox (olApp2 Is Nothing)
End Sub
This will print "False" because we created the instance.
Let's say Outlook IS running. We can use this code to verify that using GetObject and CreateObject will refer to the existing instance:
Sub testOutlook()
Dim olApp As Object ' Outlook.Application
Dim olApp2 As Object ' Outlook.Application
Set olApp = GetObject(, "Outlook.Application")
MsgBox (olApp Is Nothing)
Set olApp2 = CreateObject("Outlook.Application")
MsgBox (olApp2 Is Nothing)
MsgBox "Same object? " & (olApp Is olApp2)
End Sub
This will print "False" (existing instance), "False" (our alleged "new instance"), but the last message box is "True" because the new instance is actually the same object as the existing instance.
So what do we do if we don't know if Outlook is running or not? As demonstrated above, CreateObject either created a new instance (if one didn't exist, as in the first example) or hooked the existing instance if Outlook was already open (as in the second example).
I see in your question that you commented out
'Dim w As Outlook.Application
presumably because this gives you the "User-defined type not defined" error.
This is likely because you have not set a reference to the Outlook library in your Excel-VBA project. This is done as follows: Tools > References > check "Microsoft Outlook xx.x Object Library". Then you can write this
Dim w As Outlook.Application
Set w = New Outlook.Application
' or,
'Set w = CreateObject("Outlook.Application")
which, by the way, results in compile-time (or "early") binding. And gives you the Outlook object intellisense.
Alternatively, you can omit setting the reference and declare w as a generic object and let it bind at run-time
Dim w As Object
Set w = CreateObject("Outlook.Application")
but runtime (or "late") binding is less efficient.
Do whatever feels best -- I'm going to go ahead and venture that chances are, you won't notice the difference in efficency. I'm a recent convert to the early-binding thing, really just because of the intellisense.
EDIT So you've created a new Outlook application, but you can't see it. If you look in the Windows task manager, you'll see that the process is there, running -- but it's just not showing on the screen. Unfortunately, some brilliant engineer at Microsoft decided that Outlook shouldn't have a Visible property like Word or Excel do, so we have to use an awkward workaround. Open one of the special folders e.g. the Inbox like this:
Dim w As Outlook.Application
Dim wInbox As Outlook.MAPIFolder
Set w = New Outlook.Application
Set wInbox = w.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
wInbox.Display 'This makes Outlook visible
Set w = GetObject(, "Outlook.Application")
this should get running instance, if none is running catch error and do CreateObject
If you like, use this.
This is not a perfect solution, but you can open Outlook App when it's not be opened.
Function OpenOutlookApp(isSend As Boolean) As Boolean
' If it has opened, return true.
' my office version is 2016.
Dim oApp As Object
On Error GoTo ErrorHandle
On Error Resume Next
Set oApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If oApp Is Nothing Then
Set oApp = CreateObject("Outlook.Application")
oApp.GetNamespace("MAPI").GetDefaultFolder(6).Display
End If
If isSend Then Call SendAndReceiveOutlookMail(False)
OpenOutlookApp = True
GoTo NonErrorHandle
ErrorHandle:
NonErrorHandle:
On Error GoTo 0
End Function
Sub SendAndReceiveOutlookMail(isQuit As Boolean)
Dim oApp As New Outlook.Application
On Error Resume Next
Call oApp.Session.LogOn("Outlook", "")
Call oApp.Session.SendAndReceive(True)
If isQuit Then oApp.Quit
Set oApp = Nothing
On Error GoTo 0
End Sub