none
generate .ics file RRS feed

  • Question

  • I am writing a program from my software to generate an iCal .ics file to post to Microsoft 365 Calendar but having difficulty in 2 areas: 1) I want the .ics file to include a time frame e.g. 09.00-13.00 hrs, and 2) I want when the .ics message is issued to a specific e-mail address of our client, we would like the message to automatically post to their Microsoft 365 calendar. I have tried to change METHOD:REQUEST to METHOD:PUBLISH but this then doesn't allow the User to make a subsequent change. Any help would be appreciated
    START
    Sub send_ics(vtype,vcalendarname,vidx,vemailto,vdummy1,vdummy2,vdummy3)
               'vtype : "LR", and more for future purpose
               if IsValidEmail(vemailto) = "True" then
                           Dim sarrtmpstorage(10), icssql, icsrs, sstrbody, sarrvalue(5), CDOMail
                           sstrbody = ""
                           icssql = ""
                           sarrvalue(0) = "False"
                           sarrtmpstorage(0) = "hdes@inntempo.com"    'From Email
                           Select Case vtype
                           Case "LR"
                                      sarrtmpstorage(1) = "Leave Schedule from HDES"     'Subject
                                      icssql = "SELECT * FROM lr_hdr WHERE lrh_idx = "&savenumeric(vidx)&""
                                      Set icsrs = conn.execute(icssql)
                                      if icsrs.EOF = "False" then
                                                 sarrvalue(0) = "True"
                                                 sarrvalue(1) = icsrs("lrh_leave_date_from")
                                                 sarrvalue(2) = icsrs("lrh_leave_date_to")
                                                 sarrvalue(3) = icsrs("lrh_for")
                                                 if get_lr_reason_info(icsrs("lrh_reason"),"lrr_desc") <> "" then
                                                             sarrvalue(4) = get_lr_reason_info(icsrs("lrh_reason"),"lrr_desc")
                                                 else
                                                             sarrvalue(4) = "Leave Request"
                                                 end if
                                      end if
                           End Select
                           if sarrvalue(0) = "True" then
                                      sstrbody = sstrbody & "BEGIN:VCALENDAR"&chr(13)&chr(10)
                                      sstrbody = sstrbody & "VERSION:2.0"&chr(13)&chr(10)
                                      sstrbody = sstrbody & "PRODID:-//HDES//Leave Request//EN"&chr(13)&chr(10)
                                      sstrbody = sstrbody & "METHOD:REQUEST"&chr(13)&chr(10)
                                      sstrbody = sstrbody & "CALSCALE:GREGORIAN"&chr(13)&chr(10)
                                      sstrbody = sstrbody & "X-WR-CALNAME:"&vcalendarname&""&chr(13)&chr(10)
                                      sstrbody = sstrbody & "X-WR-TIMEZONE:Asia/Hong_Kong"&chr(13)&chr(10)
                                      sstrbody = sstrbody & "BEGIN:VTIMEZONE"&chr(13)&chr(10)
                                      sstrbody = sstrbody & "TZID:Asia/Hong_Kong"&chr(13)&chr(10)
                                      sstrbody = sstrbody & "X-LIC-LOCATION:Asia/Hong_Kong"&chr(13)&chr(10)
                                      sstrbody = sstrbody & "BEGIN:STANDARD"&chr(13)&chr(10)
                                      sstrbody = sstrbody & "TZOFFSETFROM:+0800"&chr(13)&chr(10)
                                      sstrbody = sstrbody & "TZOFFSETTO:+0800"&chr(13)&chr(10)
                                      sstrbody = sstrbody & "TZNAME:HKT"&chr(13)&chr(10)
                                      sstrbody = sstrbody & "DTSTART:19700101T000000"&chr(13)&chr(10)
                                      sstrbody = sstrbody & "END:STANDARD"&chr(13)&chr(10)
                                      sstrbody = sstrbody & "END:VTIMEZONE"&chr(13)&chr(10)
                                      sstrbody = sstrbody & "BEGIN:VEVENT"&chr(13)&chr(10)
                                      sstrbody = sstrbody & "DTSTAMP:"&generate_timestamp(now,"Z")&chr(13)&chr(10)
                                      sstrbody = sstrbody & "UID:"&generate_timestamp(now,"Z")&"-"&generatestring(10,1)&"@inntempo.com"&chr(13)&chr(10)
                                      sstrbody = sstrbody & "DTSTART;TZID=Asia/Hong_Kong:"&generate_timestamp(hkdateformat(extractmysqldatetime(sarrvalue(1),"date")),"")&chr(13)&chr(10)
                                      sstrbody = sstrbody & "DTEND;TZID=Asia/Hong_Kong:"&generate_timestamp(hkdateformat(extractmysqldatetime(sarrvalue(2),"date")),"")&chr(13)&chr(10)
                                      sstrbody = sstrbody & "SUMMARY:"&sarrvalue(4)&" ("&getuserinfo(sarrvalue(3),"fullname")&")"&chr(13)&chr(10)
                                      sstrbody = sstrbody & "DESCRIPTION:"&sarrvalue(4)&chr(13)&chr(10)
                                      sstrbody = sstrbody & "END:VEVENT"&chr(13)&chr(10)
                                      sstrbody = sstrbody & "END:VCALENDAR"&chr(13)&chr(10)
                                      Set CDOMail = CreateObject("CDO.Message")
                                      CDOMail.Subject = sarrtmpstorage(1)
                                      CDOMail.From = sarrtmpstorage(0)
                                      CDOMail.To = vemailto
                                      CDOMail.TextBody = sstrbody
                                      CDOMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
                                      CDOMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPHost  'SMTP Server
                                      CDOMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25        'Server port
                                      CDOMail.Configuration.Fields.Update
                                      CDOMail.Fields.Item ("urn:schemas:mailheader:content-type") = "text/calendar; Content-Dis; charset=utf-8;\r\nContent-Type: text/plain; charset=""utf-8"""
                                      CDOMail.Fields.Update
                                      CDOMail.Send
                                      Set CDOMail=nothing
                           end if
               end if
    End Sub
    END
    

    Sunday, July 5, 2015 8:02 AM

All replies