VBA - Connect excel with Outlook

[Phil810]

Hello,

I have a problem with VBA when trying to look at multiple cells and compare them to a criteria. I am new to VBA but I dont understand why this problem is happening.

The matter at hand is, that im trying to link excel with outlook in order to get my work shifts from excel into outlook which is then connected to my phone.

I have the code that connects me with outlook sorted. I am able to look at a single cell and if the requirements are met then it will make a entry in outlook.

The problem is, that when I try to look at multiple cells with the same criteria as before, then it gives me an error message saying: "Runtime error: 13 type mismatch"

I have no idea why this is happening.

Here is the code so far and the excel sheet:

Sub OpdaterOutlook()


Dim obJ0L As Object
Set obJ0L = CreateObject("Outlook.Application")




Set obJ0L = New Outlook.Application


Dim ONS As Outlook.Namespace
Set ONS = obJ0L.GetNamespace("MAPI")


Dim CAL_FOL As Outlook.Folder
Set CAL_FOL = ONS.GetDefaultFolder(olFolderCalendar)


Dim myapt As Outlook.AppointmentItem
Set myapt = CAL_FOL.Items.Add(olAppointmentItem)




With myapt
Dim MyCheck As String
MyCheck = "dag"
MyRange = Range("D10:D17")
MyRange2 = Range("B10:B17")


        If MyCheck = MyRange Then
        .Start = MyRange2 + TimeValue("06:45:00")

        .End = MyRange2 + TimeValue("15:00:00")

        .Subject = "Dagsvagt"
    End If

    If Sheets("MIT TIMEREGNSKAB 2017-2018").Range("D10") = "aften" Then
        .Start = Range("B10") + TimeValue("14:45:00")
        .End = Range("B10") + TimeValue("23:00:00")
        .Subject = "Aftenvagt"
    End If

    If Sheets("MIT TIMEREGNSKAB 2017-2018").Range("D10") = "nat" Then
        .Start = Range("B10") + TimeValue("22:45:00")
        .End = Range("B11") + TimeValue("07:00:00")
        .Subject = "Nattevagt"

    End If

    .Save
End With


End Sub

And about 30 min ago I knew nothing about VBA, so bare with me if the are any bad syntax.


The first column "Dato" is B10:B40 and D10:40 is the "Vagt" column

Dato	Ugedag	Vagt	Ekstra timer	Timer
Over
Arbejde
01-maj	tirsdag	dag		8,25
02-maj	onsdag	aften		8,98
03-maj	torsdag	aften	8	16,98
04-maj	fredag	aften		8,98
05-maj	lørdag	aften		8,98
06-maj	søndag	aften		8,98
07-maj	mandag	aften		8,98
08-maj	tirsdag	aften		8,98
09-maj	onsdag	overtid aft udb			17,96
10-maj	torsdag	aften		8,98
11-maj	fredag
12-maj	lørdag
13-maj	søndag
14-maj	mandag
15-maj	tirsdag
16-maj	onsdag		4,5	4,5
17-maj	torsdag	dag	1	9,25
18-maj	fredag	dag		8,25
19-maj	lørdag
20-maj	søndag
21-maj	mandag
22-maj	tirsdag	dag	1,25	9,5
23-maj	onsdag	dag	1,75	10
24-maj	torsdag
25-maj	fredag	aften		8,98
26-maj	lørdag	aften	8,25	17,23
27-maj	søndag	aften	8,25	17,23
28-maj	mandag
29-maj	tirsdag
30-maj	onsdag
31-maj	torsdag

<tbody>
</tbody>

I hope someone can help me

 

[Norie]

Re: VBA - Connect excel with Outlook problem?!

Where do you get the error?

 

[Kamolga]

Re: VBA - Connect excel with Outlook problem?!

Hi,

From my old souvenir, I had an error message when connecting 2 office applications if in VBA, I was not going to tools/reference and click outlook project library.

Else you might have an issue with a string=range (and it can not be multiple cells) in

[LEFT][COLOR=#333333][FONT=monospace]If MyCheck = MyRange Then
[/FONT][/COLOR][/LEFT]

Oh and basically if you want to look for a cell called "dag" in a range (MyRange) of multiple cells, you need to do a loop (having a cell that will be compared to the value, do something if it equals, and go to the next one). If you want to do something if one the cell equals dag and leave the loop, simply type
Goto OutofLoop before "end if" and OutofLoop: after "next dCell". That would be "if condition is met once" equivalent while the code below is "every time a cell meets the condition"

[LEFT][COLOR=#333333][FONT=monospace]MyCheck = "dag"
[/FONT][/COLOR][/LEFT]
[COLOR=#0000cd][LEFT]Dim dCell as Range[/LEFT]
[/COLOR][LEFT][COLOR=#333333][FONT=monospace]
MyRange = Range("D10:D17")
MyRange2 = Range("B10:B17")

      F[/FONT][/COLOR][COLOR=#0000cd]or each dCell in MyRange[/COLOR]
[COLOR=#333333][FONT=monospace]
        If [/FONT][/COLOR][COLOR=#0000cd]dCell.value = MyCheck [/COLOR][COLOR=#333333][FONT=monospace]Then
[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]        .Start = MyRange2 + TimeValue("06:45:00")

        .End = MyRange2 + TimeValue("15:00:00")

        .Subject = "Dagsvagt"
    End If[/FONT][/COLOR][/LEFT]
[COLOR=#0000cd]Next dCell[/COLOR]

Hope it helps

 

[Phil810]

Re: VBA - Connect excel with Outlook problem?!

Hi Kamolga,

Thanks Ive just tried your code, and now it says that I need an object as error

 

[Kamolga]

Re: VBA - Connect excel with Outlook problem?!

I think you have the same issue with Range2, you need to define a specific cell.

If I understand what you try to do, when the condition is met in colomn D "MyRange" you would like to take the value in MyRange2 (column B).

I would not define Range2 but when the value dag is met with dCell in MyRange, you can use

dCell.offset(0,-2)

to refer to the cell 0 line below, 2 columns to the left...so the first time

01-maj ​

and

17-maj ​

​the second,...

Trye to change

[LEFT][COLOR=#333333][FONT=monospace]Start = MyRange2 + TimeValue("06:45:00")
[/FONT][/COLOR][/LEFT]

by

[LEFT][COLOR=#333333][FONT=monospace]Start = [COLOR=#222222][FONT=Verdana]dCell.offset(0,-2)[/FONT][/COLOR] + TimeValue("06:45:00")[/FONT][/COLOR][/LEFT]

and same with end

 

[Phil810]

Re: VBA - Connect excel with Outlook problem?!

What I would like to do is that if the cell equals "dag" then it should look at the date in column B which is B10:B40 and then use this date to set the appointment in outlook. I dont know if this is the correct way or even possible this way. And it still says object required.

 

[Kamolga]

Re: VBA - Connect excel with Outlook problem?!

ok, I did paste your data from 01-maj in B10 and all the data until D40. I then replaced 01-maj by 01/05/2018,set them up as short date format and dragged it down to have all date formed in column B (not general).

I then opened VBA, clicked on tools, then reference and put a little "v" in Microsoft Outlook 16.0 Object Library". This step in mandatory to avoid errors.

Now when I use this macro,

Sub OpdaterOutlook()
Dim obJ0L As Object
Set obJ0L = CreateObject("Outlook.Application")
Set obJ0L = New Outlook.Application
Dim ONS As Outlook.Namespace
Set ONS = obJ0L.GetNamespace("MAPI")
Dim CAL_FOL As Outlook.Folder
Set CAL_FOL = ONS.GetDefaultFolder(olFolderCalendar)
Dim myapt As Outlook.AppointmentItem
Dim dCell As Range
    For Each dCell In Range("D10:D40")
        If dCell.Value = "dag" Then
            Set myapt = CAL_FOL.Items.Add(olAppointmentItem)
                With myapt
                        .Start = dCell.Offset(0, -2) + TimeValue("06:45:00")
                        .End = dCell.Offset(0, -2) + TimeValue("15:00:00")
                        .Subject = "Dagsvagt"
                    .Save
                End With
        End If
    Next dCell
End Sub

I got 5 appointments (1 may, 17 May, 18 May, 22 May, and 23 MAy) named "Dagsvagt" in my outlook calendar. No object required message with this one

 

[Kamolga]

Re: VBA - Connect excel with Outlook problem?!

Of course you need to be on the right sheet when you launch it and outlook can be close. You can download my test file here (https://1drv.ms/x/s!AvmGsNl7aaaAgtMTKY8klaAWIQOvow with the 3 dots top right) if needed

 

[Phil810]

Re: VBA - Connect excel with Outlook problem?!

It works perfectly! Thanks alot Kamolga! The only problem now, is that it creates dublicates.. Ive tried to sort it out in the IF sentence with "dag" and then adding AND NOT appointment exists =true sort of thing but to no avail. Do you have any tips?

 

[Kamolga]

Re: VBA - Connect excel with Outlook problem?!

Hi,

I updated the file, so you can download it. Basically I added a function "checkappointmentexist" (that returns true if the start date and time is the same and subject is identical). You can post it in the same module

[LEFT][COLOR=#222222][FONT=Verdana]Public Function CheckAppointmentExists(argCheckDate As Date, argCheckSubject As String) As Boolean
  Dim oApp As Outlook.Application
  Dim oNameSpace As Outlook.Namespace
  Dim oApptItem As Outlook.AppointmentItem
  Dim oFolder As Outlook.MAPIFolder
  Dim oMeetingoApptItem As Outlook.MeetingItem
  Dim oObject As Object
  On Error Resume Next
  ' check if Outlook is running
  Set oApp = GetObject("Outlook.Application")
  If Err <> 0 Then
    'if not running, start it
    Set oApp = CreateObject("Outlook.Application")
  End If
  Set oNameSpace = oApp.GetNamespace("MAPI")
  Set oFolder = oNameSpace.GetDefaultFolder(olFolderCalendar)
  CheckAppointment = False
  For Each oObject In oFolder.Items
    If oObject.Class = olAppointment Then
      Set oApptItem = oObject
      If oApptItem.Start = argCheckDate Then
        CheckAppointment = True
      End If
    End If
  Next oObject
  Set oApp = Nothing
  Set oNameSpace = Nothing
  Set oApptItem = Nothing
  Set oFolder = Nothing
  Set oObject = Nothing
End Function
[/FONT][/COLOR][/LEFT]

Then the macro is aupdated with "if checkappointmentexist = true do nothing else add the appointment" and that works for me, he adds only the one I deleted after I runned the macro and no more duplicates
​

[LEFT][COLOR=#222222][FONT=Verdana]Sub OpdaterOutlook()[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]Dim obJ0L As Object[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]Set obJ0L = CreateObject("Outlook.Application")[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]Set obJ0L = New Outlook.Application[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]Dim ONS As Outlook.Namespace[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]Set ONS = obJ0L.GetNamespace("MAPI")[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]Dim CAL_FOL As Outlook.Folder[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]Set CAL_FOL = ONS.GetDefaultFolder(olFolderCalendar)[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]Dim myapt As Outlook.AppointmentItem[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]Dim dCell As Range[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]    For Each dCell In Range("D10:D40")[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]        If dCell.Value = "dag" Then[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]            If CheckAppointmentExists(dCell.Offset(0, -2) + TimeValue("06:45:00"), "Dagsvagt") = True Then[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]              Else[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]               Set myapt = CAL_FOL.Items.Add(olAppointmentItem)[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]                   With myapt[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]                           .Start = dCell.Offset(0, -2) + TimeValue("06:45:00")[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]                           .End = dCell.Offset(0, -2) + TimeValue("15:00:00")[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]                           .Subject = "Dagsvagt"[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]                       .Save[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]                   End With[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]            End If[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]        End If[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]    Next dCell[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]End Sub
[/FONT][/COLOR][/LEFT]

​