Outlook Appointment

[ac.smith]

Hi First post, hope it is in the right place.

I have a small VBA script that I want to read in a contact txt file for email addresses and add them to a meeting appointment in outlook,

all seems to work but when it opens the appointment to display it the attendees are not shown and I have to manually click the Add/Invite button then all attendees loaded in will show.

Is there a way so I do not have to do this manually??

Here is my code.


Public Sub Test2()
Dim OutApp As Object
Dim OutMail As Object
Dim myDate As Variant
Dim myFile As String, emails As String, textline As String


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(1)
On Error Resume Next

myFile = "C:\Users\asmith6\Documents\01. Work\02. Development\03. Lunch & Learns\CSYS.txt"
Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
emails = emails & textline
Loop
Close #1

With OutMail

.OptionalAttendees = emails
.Subject = "Test"
.Importance = True
.Start = "12:00 PM" & Date
.End = "01:00 PM" & Date
.Body = "Lunch"
.Display


End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub


Thanks.

Adam

[excelliot]

hi can you send sample text file? needed to understand your data structure in text file for importing.

[ac.smith]

Hi, The text file is just a list of emails, line by line, for example:

emailaddress1;
emailaddress2;
emailaddress3;

and so on.

Thanks Adam.

[gmayor]

I take it that we can assume that this macro is not being run from Outlook VBA? That being the case they following will work:


Option Explicit

Public Sub Test2()
Dim OutApp As Object
Dim OutMail As Object
Dim myDate As Variant
Dim myOptionalAttendee As Variant
Dim myFile As String, textline As String


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(1)
On Error Resume Next

myFile = "C:\Users\asmith6\Documents\01. Work\02. Development\03. Lunch & Learns\CSYS.txt"

If Not FileExists(myFile) Then GoTo lbl_exit

With OutMail
.MeetingStatus = 1
Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
Set myOptionalAttendee = OutMail.Recipients.Add(textline)
myOptionalAttendee.Type = 2
Loop
Close #1
.Subject = "Test"
.Location = "The Greasy Spoon"
.Importance = True
.Start = "04:00 PM" & Date
.End = "05:00 PM" & Date
.Reminder = False
.Body = "Lunch"
.Display
.send
End With
lbl_exit:
Set OutMail = Nothing
Set OutApp = Nothing
Exit Sub
End Sub

Private Function FileExists(strFullName As String) As Boolean
'Graham Mayor (www.gmayor.com)
'strFullName is the name with path of the file to check
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(strFullName) Then
FileExists = True
Else
FileExists = False
End If
lbl_exit:
Exit Function
End Function

[ac.smith]

Thanks for the response, I am using the Outlook VBA editor.

The code works and does add the contacts to the meeting invite. The issue is that unless I physically click the add attendees button on the invite outlook does not add the emails in my array to the invite and there is no send option.

As soon as I click the add attendee button all 30 contacts from the .txt file pop up and the send button appears, I basically want a way to remove this step of me manually clicking the add attendee button and have the VBA code just do it for me.

If it was in excel I could start recording a macro then click the button and use that code but I believe Outlook does not have this function available.

Sorry if I was not clear in what I was after.

Adam.

[gmayor]

The code I posted, based on your original, is not suitable for Outlook. It is code for Excel or Word as it creates a new Outlook application. Working in Outlook you don't need that as you are already in Outlook e.g. change the main macro as follows
Option Explicit

Public Sub Test2()
Dim OutMail As Outlook.AppointmentItem
Dim myDate As Date
Dim myOptionalAttendee As Recipient
Dim myFile As String, textline As String

Set OutMail = CreateItem(olAppointmentItem)
On Error Resume Next

myFile = "C:\Users\asmith6\Documents\01. Work\02. Development\03. Lunch & Learns\CSYS.txt"
If Not FileExists(myFile) Then GoTo lbl_exit

With OutMail
.MeetingStatus = 1
Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
Set myOptionalAttendee = OutMail.Recipients.Add(textline)
myOptionalAttendee.Type = 2
Loop
Close #1
.Subject = "Test"
.Location = "The Greasy Spoon"
.Importance = True
.Start = "04:00 PM" & Date
.End = "05:00 PM" & Date
.Reminder = False
.Body = "Lunch"
.Send
End With
lbl_exit:
Set OutMail = Nothing
Exit Sub
End Sub

The macro creates the appointment and sends the messages to the named recipients.