Results 1 to 11 of 11
  1. #1
    New Lounger
    Join Date
    Apr 2015
    Posts
    6
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Question Making a Macro to send dates from Excel to Outlook Calendar

    Hi all,
    First of all sorry for my bad english.
    I am making an excel (attached) where I do want to send to my Outlook Calendar the "n║" "Client" "Taxes" "Water" and "Car" if the date has passed. On outlook calendar something like "n║5 JosÚ Mourinho Taxes"(if the date has passed of course).
    I do not know if this is posible to do or not. I do not understand (or almost nothing) of Vba, and I would like some tips from you!
    Is it posible to do?
    If you did not understand what I said please feel free to ask me!
    Thank you very much for your help.
    Book3.xlsx

  2. #2
    3 Star Lounger Supershoe's Avatar
    Join Date
    Apr 2014
    Location
    Austin, TX
    Posts
    252
    Thanks
    1
    Thanked 36 Times in 34 Posts
    Don Guillett
    Excel Developer
    dguillett @gmail.com

  3. #3
    New Lounger
    Join Date
    Apr 2015
    Posts
    6
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Smile See if I am going on the right track.

    Hi again, I am trying a lot to make it work. I already get a code that is almost functional. The only problem is when it gets a blank cell it stops or it says it is on 1900(year).

    Is there some kind of a code I could bypass an empty cell and make it till the end?

    I send the code and the excel where is the macro.


    Sub IMI()
    Set myOutlook = CreateObject("Outlook.Application")
    r = 3
    Do Until Trim(Cells(r, 1).Value) = ""

    Set myApt = myOutlook.CreateItem(1)

    myApt.Subject = Cells(r, 1) & " IMI " & Cells(r, 2).Value
    myApt.Location = Cells(r, 2).Value
    If (Cells(r, 4).Value) = "" Then
    myApt.Start = r = r + 1
    Else
    myApt.Start = Cells(r, 4).Value
    End If
    myApt.Duration = Cells(r, 17).Value

    If Trim(Cells(r, 5).Value) = "" Then
    myApt.BusyStatus = 2
    Else
    myApt.BusyStatus = Cells(r, 17).Value
    End If
    If Cells(r, 18).Value > 0 Then
    myApt.ReminderSet = True
    myApt.ReminderMinutesBeforeStart = Cells(r, 18).Value
    Else
    myApt.ReminderSet = False
    End If
    myApt.Body = Cells(r, 1).Value
    myApt.Save
    r = r + 1
    Loop
    End Sub



    As you can see on the code I already tried to skip the blank one ("") but did not worked, any help would be helpful. Thank you all.
    BTW I am going to make several macros to each one of them to work separately (since I could not find any macro to several columns) and then I will make a final macro to run all of them at same time.

    Post Scriptum: I know that Outlook import and export works but I need something a little more simple for other people to use not just me. Thanks!
    Book3.xlsm
    Last edited by Filipe Sousa; 2015-04-16 at 18:36.

  4. #4
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,638
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Assuming your code works since I have not tested it, changing the two lines highlighted in blue should get you to the end.

    HTH,
    Maud


    Code:
    Sub IMI()
    Set myOutlook = CreateObject("Outlook.Application")
    r = 3
    LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
    Do Until r = LastRow
        Set myApt = myOutlook.CreateItem(1)
        myApt.Subject = Cells(r, 1) & " IMI " & Cells(r, 2).Value
        myApt.Location = Cells(r, 2).Value
        If (Cells(r, 4).Value) = "" Then
              myApt.Start = r = r + 1
        Else
             myApt.Start = Cells(r, 4).Value
        End If
        myApt.Duration = Cells(r, 17).Value
        If Trim(Cells(r, 5).Value) = "" Then
             myApt.BusyStatus = 2
        Else
             myApt.BusyStatus = Cells(r, 17).Value
        End If
        If Cells(r, 18).Value > 0 Then
             myApt.ReminderSet = True
             myApt.ReminderMinutesBeforeStart = Cells(r, 18).Value
        Else
             myApt.ReminderSet = False
        End If
        myApt.Body = Cells(r, 1).Value
        myApt.Save
        r = r + 1
    Loop
    End Sub

  5. The Following User Says Thank You to Maudibe For This Useful Post:

    Filipe Sousa (2015-04-17)

  6. #5
    New Lounger
    Join Date
    Apr 2015
    Posts
    6
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Smile

    Thank you Maudibe,

    It is almost good in fact now it resumes till the last line but it assumes where it is "" that is a 0 because it adds an appointment on 1/1/1900. Does this have a solution?

    Thank you very much for your efforts.

  7. #6
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,638
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Filipe,

    Change code in blue:
    Code:
    Sub IMI()
    Set myOutlook = CreateObject("Outlook.Application")
    r = 3
    LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
    Do Until r = LastRow
        Set myApt = myOutlook.CreateItem(1)
        myApt.Subject = Cells(r, 1) & " IMI " & Cells(r, 2).Value
        myApt.Location = Cells(r, 2).Value
        If (Cells(r, 4).Value) = "" Then
              GoTo Continue
              'myApt.Start = r + 1
        Else
             myApt.Start = Cells(r, 4).Value
        End If
        myApt.Duration = Cells(r, 17).Value
        If Trim(Cells(r, 5).Value) = "" Then
             myApt.BusyStatus = 2
        Else
             myApt.BusyStatus = Cells(r, 17).Value
        End If
        If Cells(r, 18).Value > 0 Then
             myApt.ReminderSet = True
             myApt.ReminderMinutesBeforeStart = Cells(r, 18).Value
        Else
             myApt.ReminderSet = False
        End If
        myApt.Body = Cells(r, 1).Value
        myApt.Save
    Continue:
        r = r + 1
    Loop
    End Sub

  8. #7
    New Lounger
    Join Date
    Apr 2015
    Posts
    6
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Talking

    Thank you so much Maudibe,
    It works flawlessly

    I will try now to find some code to try not to repeat all the time I run the macro (repetition of the same appointments on outlook). But that is another story

    Thank you so much,

    Filipe Sousa

  9. #8
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,638
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Filipe,

    You might want to add a column and let the code and an "X" if the reminder was created. Then when the code runs, if it finds an "" in Cells(r, 4).Value or a "X" in column Z then Goto continue

    Code:
    If Cells(r, 4).Value = "" OR Ucase(Cells(r,"Z"))="X" Then
     Goto Continue
    
    
    
    If Cells(r, 18).Value > 0 Then
             myApt.ReminderSet = True
             myApt.ReminderMinutesBeforeStart = Cells(r, 18).Value
             Cells(r,"Z") = "X"
    Else
    You can hide the column of X's if you like and they will remain in place to inhibit a repeat until you clear them.

    HTH,
    Maud
    Attached Files Attached Files

  10. #9
    New Lounger
    Join Date
    Apr 2015
    Posts
    6
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Cool No words to describe how much you help...

    Hi Maudibe again,

    After a few hours to find something useful to cleanup some duplicate outlook appointments, I found one that it will solve but (dunno why) not at once. I mean if I run the code several times it will clean up all duplicates but not all at once.
    That is not a problem for me (my computer can process much faster than me) so I rerun the code and finally I get 0 duplicates. I know you spent some time trying to get a code for me, and I am sorry, I did not want you to spend any more time with me since you solved my question (and did not know you are trying to) . Glad you tried and I am really happy that I gaved you thank you because I thought you worthed it and now I think you need even more.
    Well not trying your code yet but trying to fix one code I get (but not full functional at once) I am trying to get some code that make a loop till I got 0 duplicates.
    Hopefully I will get an help from you, if not don't be sad because nowadays is not easy to get help for someone we don't know and you were BRILLIANT with your help. Yeah I know many people will look at the code you made and will say (a kid would do it) but unfortunately I do not know any kid who makes it and the only one who tried to help was you.
    Neverthless here it is the code I found and it some kind of works...


    Sub Delete_Duplicate_Appointments()

    Const olFolderCalendar = 9

    Set myOlApp = CreateObject("Outlook.Application")
    Set myNameSpace = myOlApp.GetNamespace("MAPI")
    Set myFolder = myNameSpace.GetDefaultFolder(olFolderCalendar)
    Set myItems = myFolder.Items

    Dim strTri
    strTri = ""
    strTri = strTri & "[Start]"
    strTri = strTri & "[End]"
    strTri = strTri & "[Subject]"
    strTri = strTri & "[Body]"
    strTri = strTri & "[AllDayEvent]"
    strTri = strTri & "[Sensitivity]"

    myItems.Sort strTri


    Dim lastStr, Str, nbrDelete
    lastStr = ""

    nbrDelete = 0
    For Each Item In myItems

    Str = ""
    Str = Str & vbCrLf & Item.Start
    Str = Str & vbCrLf & Item.End
    Str = Str & vbCrLf & Item.Subject
    Str = Str & vbCrLf & Item.Body
    Str = Str & vbCrLf & Item.AllDayEvent
    Str = Str & vbCrLf & Item.Sensitivity

    Str = Replace(Str, vbCrLf & vbCrLf, vbCrLf)
    Str = Replace(Str, vbCrLf & vbCrLf, vbCrLf)
    Str = Replace(Str, vbCrLf & vbCrLf, vbCrLf)
    Str = Replace(Str, vbCrLf & vbCrLf, vbCrLf)
    Str = Replace(Str, vbCrLf & vbCrLf, vbCrLf)

    If Str = lastStr Then
    Item.Delete
    nbrDelete = nbrDelete + 1
    End If
    lastStr = Str
    Next

    MsgBox "Nbr appointments deleted : " & nbrDelete





    If (not the condition from Vba) you/someone can help I am really happy.

    Thank you all and specially to Maudibe

    I just need that nbrDelete = 0

    Post Scriptum: I do not need the MsgBox to tell me I got 0 duplicates I just need them to go away
    I even tried:
    Loop Until nbrDelete = 0
    but Vba did not understand (or I am not a programmer)
    Last edited by Filipe Sousa; 2015-04-17 at 18:42. Reason: some english errors (many more I think) :)

  11. #10
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,638
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Filipe,

    I think I may have misunderstood you, apologies. The code additions in post #8 were based on the thought that you were looking for a way not to create a reminder if it was previously created. It appears though you are looking for a way to find duplicate reminders and remove them. However, if you add the code from that post, it will have prevented you from making duplicates in the first place. Take a look at my file and see if it does what you need to accomplish.

    Run the code and you will see that it places an "X" in column Z for every reminder created. Run the code again and none of them will be created again because of the presence of the "X". Remove a couple "X"s from column Z and run the code a third time. You will see that only for those whose "X" was removed, a new reminder will be created.

    I don't think you need to add a new routine that you will have to run separately to clean things up when it all can be prevented with two statements......unless your rows have duplicate entries? Still, I believe there is a might be a betty way to accomplish it.

    Maud

  12. #11
    New Lounger
    Join Date
    Apr 2015
    Posts
    6
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Right again

    No need to make the same arguments again, you rock

    Yes it is easier as I do not make another routine to delete duplicates. It works again flawlessly. I wish I would know a little bit more of Vba. Please do not tell me to learn it. I find it quite complicated.

    Once again tyvm Maudibe.

    If this topic is not replied on 3 days more please close it! Because unless anything goes really wrong I think I will handle it!

    I will make sure I will visit this forum many times, 1st I love Excel, 2nd everyday I am learning (Vba slowwwwwlllllllllyyyy) and Excel almost everyday!

    Greetings from Portugal,

    Filipe Sousa

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •