-
exporting excel data to Outlook
I'm working on a vacation tracking excel spreadsheet, but I wanted to add the ability for managers to export the vacation dates into a calendar in Outlook.
I have the actual importing working, but am having trouble using the Outlook find method. What I want to do is use the find method to check if the vacations being passed from the excel sheet don't already exist in the Outlook calendar. However, no matter what filters I set, it fails to recognize the entries already in Outlook, and adds duplicate entries. Any ideas what I'm doing wrong?
The fields being imported from the excel sheet are start and finish time, and the subject (the name of ther person taking a vacation).
----------
[vba]
'This sub reads all entries from the Outlook export worksheet, and copies
' the information directly to a sub-folder calendar in Outlook. If you
' want to copy the information directly to your main calendar, remove the
' line indicated below.
Sub exportdirecttooutlook()
Dim start_date As Date
Dim start_time As Date
Dim finish_date As Date
Dim fin_time As Date
Dim subj As String
Dim exportrow As Integer
Dim start_full As Date
exportrow = 2
' Cycles through all the entries on the worksheet
Do
subj = Worksheets("Outlook export").Cells(exportrow, 2)
start_date = Worksheets("Outlook export").Cells(exportrow, 3)
start_time = Worksheets("Outlook export").Cells(exportrow, 4)
finish_date = Worksheets("Outlook export").Cells(exportrow, 5)
fin_time = Worksheets("Outlook export").Cells(exportrow, 6)
start_full = Format(start_date & Chr(32) & start_time, "mmmm dd, yyyy h:nn AMPM")
Dim myOlApp As Outlook.Application
Dim myApptItem As Outlook.AppointmentItem
Dim myNamespace As Outlook.Namespace
Dim myAppt As Outlook.MAPIFolder
Dim myfolder As Outlook.MAPIFolder
Dim apptItems As Outlook.Items
' Opens instance of Outlook
Set myOlApp = CreateObject("Outlook.Application")
' Gets the names of all directories in user's Outlook application
Set myNamespace = myOlApp.GetNamespace("MAPI")
' Moves to the default Calendar folder
Set myAppt = myNamespace.GetDefaultFolder(olFolderCalendar)
' Select the first subfolder within the Calendar folder (0 would be
' the default.)
' **Remove this line if you want to copy directly to your main calendar**
Set myfolder = myAppt.Folders(1)
' checks if the entry already exists in the user's calendar. If so, it skips
' the process of adding that vacation.
Set apptItems = myfolder.Items
Set myApptItem = apptItems.Find("[subject] = subj and [start] = '" & _
Format(start_full, "mmmm dd, yyyy h:nn AMPM") & "'")
If Not TypeName(myApptItem) = "Nothing" Then
Else
' Creates a new appointment
Set myApptItem = myfolder.Items.Add(olAppointmentItem)
' Setup appointment information
With myApptItem
.subject = subj
.AllDayEvent = True
.ReminderSet = False
.Location = "On Vacation"
.start = start_date & " " & start_time
.End = finish_date & " " & fin_time
End With
' Save Appointment
myApptItem.Save
End If
' go to next entry on outlook export worksheet.
exportrow = exportrow + 1
Loop While Worksheets("Outlook export").Cells(exportrow, 2) <> ""
End Sub
[/vba]
------
Hope the solution isn't too embarassingly simple...
-
I don't have a solution for you Slothboi, but I've taken the liberty of putting VBA tags around your code - you can do this by selecting the text and clicking on the "vba" button.
Welcome to the Board!
-
D'oh
Found my own solution, and boy was it a silly mistake. The problem with the line of find code was that I was passing in the string "subj" instead of the _variable_ subj.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules