Sending meeting requests using ical through outlook - vb.net

Here is my dilemma. I have a vb.net application for requesting time using an asset. The user submits a request (can contain required and optional users), then an approver has to approve it. When it is approved, I want to send a meeting request. I can't do it using outlook code since it won't let me change the organizer. If I try to send it using outlook.application > outlook.olitemtype.olappointmentitem or whatever it is, it will default the organizer to the person sending the meeting request, which in this case is the approver, which I don't want. So I think I am left with trying to send an ical. This is where I am having issues. I can't use smtpclient to create the email and send it using the proper content-type, etc. I have to send it using outlook. So I create an ics file and add it as an attachment. I am not sure the difference between METHOD:PUBLISH and METHOD:REQUEST. All the searches I've have done say I should use method:request, but when i open the ICS file, it doesn't give me the options to accept, etc. It doesn't add to my calendar. I want the ability to be able to update and cancel the meeting as well, which I think I know how to do with uid, sequence, etc. I've done searches and just can't get to where I need to be. It looks like the best option is to use smtpclient to create the mail message where you add the headers and ical stuff, but I can't do that, is there a way to it using outlook?
If someone can help point me in the right direction, I would greatly appreciate it.
Here is my current code:
Dim msg As MailMessage = New MailMessage
msg.From = New MailAddress(br.requesting_user_email)
msg.To.Add(New MailAddress(br.requesting_user_email))
msg.Subject = variables.UserInfo.last_name & ", " + variables.UserInfo.first_name & " has approved your request through the Bench Scheduler."
Dim bodytxt As String = "User: " & variables.UserInfo.last_name & ", " + variables.UserInfo.first_name & vbLf & "5+2: " + variables.UserInfo.username & vbLf & vbLf
bodytxt += "Has approved your bench request for " & br.program_name & " - " & br.project_name & "." & vbLf & vbLf
bodytxt += "Start: " & br.start_time & vbLf & "End: " & br.end_time & vbLf
bodytxt += "Bench: " & br.bench_name & vbLf & "Priority: " & br.priority & vbLf & "Purpose: " & br.objective & vbLf & vbLf
bodytxt += "Request Notes: " & br.notes & vbLf & vbLf
bodytxt += vbLf & vbLf & vbLf & "This email was automatically generated by Bench Scheduler. You may respond to this email."
msg.Body = bodytxt
Dim str As StringBuilder = New StringBuilder
str.AppendLine("BEGIN:VCALENDAR")
str.AppendLine("PRODID:-//Microsoft Corporation//Outlook 15.0 MIMEDIR//EN")
str.AppendLine("VERSION:2.0")
If cancel Then
str.AppendLine("METHOD:CANCEL")
Else
str.AppendLine("METHOD:REQUEST")
End If
str.AppendLine("BEGIN:VEVENT")
str.AppendLine("X-MS-OLK-FORCEINSPECTOROPEN:TRUE")
str.AppendLine("BEGIN:VTIMEZONE")
str.AppendLine("TZID:Eastern Standard Time")
str.AppendLine("BEGIN:STANDARD")
str.AppendLine("DTSTART:16011104T020000")
str.AppendLine("RRULE:FREQ=YEARLY;BYDAY=1SU;BYMONTH=11")
str.AppendLine("TZOFFSETFROM:-0400")
str.AppendLine("TZOFFSETTO:-0500")
str.AppendLine("END:STANDARD")
str.AppendLine("BEGIN:DAYLIGHT")
str.AppendLine("DTSTART:16010311T020000")
str.AppendLine("RRULE:FREQ=YEARLY;BYDAY=2SU;BYMONTH=3")
str.AppendLine("TZOFFSETFROM:-0500")
str.AppendLine("TZOFFSETTO:-0400")
str.AppendLine("END:DAYLIGHT")
str.AppendLine("END:VTIMEZONE")
Dim dt As New DataTable
Dim ta As New BSDataSetTableAdapters.getUserRequestTableAdapter
dt = ta.GetData(br.request_id, "T")
For Each row As DataRow In dt.Rows
If row("type") = "Required" Then
str.AppendLine(String.Format("ATTENDEE;CN='{0}';RSVP=TRUE:mailto:{1}", row("username"), row("email")))
ElseIf row("type") = "Optional" Then
str.AppendLine(String.Format("ATTENDEE;CN='{0}';ROLE=OPT-PARTICIPANT;RSVP=TRUE:mailto:{1}", row("username"), row("email")))
End If
Next
str.AppendLine("CLASS:PUBLIC")
str.AppendLine("CREATED:" & Format(Date.Now, "yyyyMMddTHHmmssZ"))
str.AppendLine(String.Format("DESCRIPTION:{0}", br.objective))
str.AppendLine("DTEND;TZID=" & """" & "Eastern Standard Time" & """" & ":" & Format(CDate(br.end_time), "yyyyMMddTHHmmss"))
str.AppendLine("DTSTAMP:" & Format(Date.Now, "yyyyMMddTHHmmssZ"))
str.AppendLine("DTSTART;TZID=" & """" & "Eastern Standard Time" & """" & ":" & Format(CDate(br.start_time), "yyyyMMddTHHmmss"))
str.AppendLine(String.Format("LOCATION:{0}", br.bench_name))
str.AppendLine(String.Format("ORGANIZER;CN='" & br.requesting_username & "':mailto:" & br.requesting_user_email))
str.AppendLine("PRIORITY:5")
str.AppendLine("SEQUENCE:0")
str.AppendLine(String.Format("SUMMARY;LANGUAGE=en-us:{0}", "Approved Bench Request (ID-" & br.request_id & "): " & br.program_name & "-" & br.project_name & "-" & br.activity))
str.AppendLine("TRANSP:OPAQUE")
str.AppendLine(String.Format("UID:{0}", br.uid))
str.AppendLine(String.Format("X-ALT-DESC;FMTTYPE=text/html:{0}", br.objective))
str.AppendLine("X-MICROSOFT-CDO-BUSYSTATUS:BUSY")
str.AppendLine("X-MICROSOFT-CDO-IMPORTANCE:1")
str.AppendLine("X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY")
str.AppendLine("X-MICROSOFT-DISALLOW-COUNTER:FALSE")
str.AppendLine("X-MS-OLK-AUTOFILLLOCATION:FALSE")
str.AppendLine("X-MS-OLK-CONFTYPE:0")
str.AppendLine("BEGIN:VALARM")
str.AppendLine("TRIGGER:-PT30M")
str.AppendLine("ACTION:DISPLAY")
str.AppendLine("DESCRIPTION:Reminder")
str.AppendLine("END:VALARM")
str.AppendLine("END:VEVENT")
str.AppendLine("END:VCALENDAR")
Dim smtpclient As SmtpClient = New SmtpClient
smtpclient.Host = "replaced for privacy"
smtpclient.Credentials = System.Net.CredentialCache.DefaultNetworkCredentials
Dim contype As System.Net.Mime.ContentType = New System.Net.Mime.ContentType("text/calendar")
contype.Parameters.Add("method", "REQUEST")
contype.Parameters.Add("name", "Meeting.ics")
Dim avcal As AlternateView = AlternateView.CreateAlternateViewFromString(str.ToString, contype)
msg.AlternateViews.Add(avcal)
smtpclient.Send(msg)

Related

Windows form - Automatic email issue - VB.NET

Here is my code to generate an email and display it to the user:
Imports Outlook = Microsoft.Office.Interop.Outlook
Private Function ReadSignature(sigName As String) As String
Dim oFSO, oTextStream As Object
Dim appDataDir, sig, sigPath, fileName As String
appDataDir = Environ("APPDATA") & "\Microsoft\Signatures"
sigPath = appDataDir & "\" & sigName
oFSO = CreateObject("Scripting.FileSystemObject")
oTextStream = oFSO.OpenTextFile(sigPath)
sig = oTextStream.ReadAll
' fix relative references to images, etc. in sig
' by making them absolute paths, OL will find the image
fileName = Replace(sigName, ".htm", "") & "_files/"
sig = Replace(sig, fileName, appDataDir & "\" & fileName)
ReadSignature = sig
End Function
Private Sub Email()
Dim INC As String
INC = wb1.Document.GetElementById("arid_WIN_2_1000000161").InnerText
Dim sig As String
' MainSig.htm is the name you gave your signature in the OL Options dialog
sig = ReadSignature("MainSig.htm")
Dim Outl As Object
Outl = CreateObject("Outlook.Application")
If Outl IsNot Nothing Then
Dim omsg As Object
omsg = Outl.CreateItem(0)
omsg.To = TextBox35.Text
omsg.cc = TextBox37.Text
omsg.subject = INC & TextBox38.Text
omsg.HTMLBody = "<p>" & TextBox40.Text & "</p><p>" & TextBox41.Text & "</p><p>" & "<p>INC# : " & INC & "<br/>TMS ID: " & TextBox2.Text & TextBox4.Text & "</p><p>Issue : " & "<br/>Resulting in: " & ComboBox6.Text & "<br/>Issue Resolved?: " & TextBox29.Text & "<br/>User error?: " & TextBox30.Text & "</p><p>Person reporting (Or name Of caller): " & TextBox1.Text & "<br/>Reported Source: " & ComboBox2.Text & "<br/>INC# Provided to customer: " & TextBox21.Text & "<br/>Date And Time: " & DateTimePicker2.Value & "<br />(MM/DD/YYYY HH:MM) " & ComboBox1.Text & "</p><p>Site(s) affected:<br />" & TextBox5.Text & "<br/>" & TextBox6.Text & "</p><p>Additional notes: <br />" & TextBox3.Text & "</p><p>" & TextBox24.Text & "<br /></p><p>Impact : " & ComboBox3.Text & "<br />Urgency: " & ComboBox4.Text & "<br /></p><p>" & sig
omsg.Display(True)
End If
End Sub
This is great for when users need to escalate a ticket, as it allows them to add any extra notes before sending it, however I am trying to make it send a copy of every ticket created (whether escalated or not) to our main mailbox as well as any escalation emails (preferably it will be done in the background, without relying on the user clicking send rather than just closing it as i know some of them would).
The issue is when i change omsg.Display(True) to omsg.send it throws an exception and fails
I've even tried leaving omsg.Display(True) and adding omsg.send on the next line, but that just displays the message and then throws the exception
I've read somewhere that it could be a group policy designed to stop self replicating viruses emailing themselves to everyone in your address book, if this is the case can any of you think of a workaround?
Thank you in advance.
Most probably you get a security issue. "Security" in this context refers to the so-called "object model guard" that triggers security prompts and blocks access to certain features in an effort to prevent malicious programs from harvesting email addresses from Outlook data and using Outlook to propagate viruses and spam. These prompts cannot simply be turned off, except in Outlook 2007 and later with an anti-virus application running. This page discusses strategies for avoiding the security prompts:
Develop a COM add-in which doesn't trigger security issues.
You can use the Outlook Security Manager component for disabling security prompts in Outlook.
Use a low-level API on which Outlook is based on and which doesn't trigger security issues/prompts - Extended MAPI or any other third-party wrapper around that API (such as Redemption).
Deploy Outlook security settings via GPO.

AutoCAD VBA: Selecting objects

I have a 3D model of an intricate chimney which is essentially a cylindrical tube with decorative features. I'd like to write a VBA script which find the section properties at several points along its length but I'm not really sure how to do it.
From online searches, I've managed to write a code which puts in a section at a point which I can then run MASSPROP on but I'm not quite sure how to finish it off... I think I'm only one line of code away. I just need to select the section that I've just created.
My almost complete code is below with a comment on the line that I need help with.
Public Sub Section()
Dim SolidObject As Acad3DSolid
Dim NewRegionObject As AcadRegion
Dim PlaneOrigin As Variant
Dim PlaneXaxisPoint As Variant
Dim PlaneYaxisPoint As Variant
Dim PickedPoint As Variant
On Error Resume Next
With ThisDrawing.Utility
.GetEntity SolidObject, PickedPoint, vbCr & "Select solid to cut."
If Err Then
MsgBox "Selected solid must be a 3DSolid"
Exit Sub
End If
PlaneOrigin = .GetPoint(PickedPoint, vbCr & "Select point to define origin.")
PlaneXaxisPoint = .GetPoint(PickedPoint, vbCr & "Select point to define x-axis.")
PlaneYaxisPoint = .GetPoint(PickedPoint, vbCr & "Select point to define y-axis.")
Set NewRegionObject = SolidObject.SectionSolid(PlaneOrigin, PlaneXaxisPoint, PlaneYaxisPoint)
End With
ThisDrawing.SendCommand ("qaflags" & vbCr & "2" & vbCr) 'This is needed for the operation
ThisDrawing.SendCommand ("massprop" & vbCr)
'How do I select my NewRegionObject???
ThisDrawing.SendCommand (vbCr & vbCr & "y" & vbCr & vbCr & "y" & vbCr)
End Sub
If I can get this code to run MASSPROP with my newly created section fine I should be able to adapt it to do the process automatically at several points along the chimney so I think I'm only one line of code off.
Thanks for your help,
Tom
you'd better exploit Autocad Object Model:
Dim minPoint As Variant, maxPoint As Variant
Set NewRegionObject = SolidObject.SectionSolid(PlaneOrigin, PlaneXaxisPoint, PlaneYaxisPoint)
With NewRegionObject
MsgBox "Area: " & .Area
MsgBox "Perimeter: " & .Perimeter
.GetBoundingBox minPoint, maxPoint
MsgBox "Min Point coordinates: (" & minPoint(0) & "," & minPoint(1) & "," & minPoint(2) & ")"
MsgBox "Max Point coordinates: (" & maxPoint(0) & "," & maxPoint(1) & "," & maxPoint(2) & ")"
MsgBox "Centroid coordinates: (" & .Centroid(0) & "," & .Centroid(1) & ")"
MsgBox "Moments of Inertia: (" & .MomentOfInertia(0) & "," & .MomentOfInertia(1) & "," & .MomentOfInertia(2) & ")"
'.. and so on
End With

URL monitor keeps increasing memory usage

I have written a URL monitoring program in vb using .net 4.0. Basically it sets a timer checks the url every 60 minutes using an htpwebreques/httpwebresponse and sends an email if the url is down. However the memory used by the application keeps increasing every time the url is checked. This will obviously eventually cause a problem as the app is designed to run permanently monitoring a website for availability and the monitoring machine will eventually run out of resources.
Code for my CheckURL routine below. Any advice greatly appreciated, thanks in advance.
Private Sub checkURL()
Timer1.Stop()
Dim wReq As HttpWebRequest
Dim wResp As HttpWebResponse ' WebResponse
wReq = HttpWebRequest.Create(url)
wReq.Method = "HEAD"
Try
wResp = wReq.GetResponse()
If wResp.StatusCode = 200 Then
txtResponse.Text = wResp.StatusCode & ": " & wResp.StatusDescription & vbNewLine & "The " & siteName & " is up"
'Only send success results if specified
If sendOnFailure = False Then
sendResults = True
End If
Else txtResponse.Text = "There may be a problem with the " & siteName & vbNewLine & "Please verify manually that it is operational." & vbNewLine & "The response received was:" & vbNewLine & "Status Code: " & wResp.StatusCode & " - " & wResp.StatusDescription
sendResults = True
End If
wResp.Close()
wResp = Nothing
wReq = Nothing
Catch ex As Exception
txtResponse.Text = "There may be a problem with the " & siteName & vbNewLine & "The error returned was:" & vbNewLine & ex.ToString
sendResults = True
End Try
txtLastCheck.Text = Now.ToString("d MMM yyyy HH:mm")
setNextCheck()
End Sub
First, you should use Option Strict On, which will show you where you have variable type mismatches and may even suggest corrections for you, for example, see where the DirectCast operator is used in the following code.
Second, HttpWebResponse has a .Dispose() method, so you should call that when you have finished using it, or, as Zaggler pointed out, you can use Using to ensure that unmanaged resources are cleaned up properly, thus removing the memory leak you are concerned with. Note that there may be other similar problems in the code we can't see.
You should not set things to Nothing in an attempt to get rid of them - doing so messes with the garbage collector and does nothing to ensure their clean disposal.
Option Strict On
' ....
Private Sub checkURL()
timer1.Stop()
Dim wReq As HttpWebRequest = DirectCast(HttpWebRequest.Create(url), HttpWebRequest)
wReq.Method = "HEAD"
Try
Using wResp As HttpWebResponse = DirectCast(wReq.GetResponse(), HttpWebResponse)
If wResp.StatusCode = 200 Then
txtResponse.Text = wResp.StatusCode & ": " & wResp.StatusDescription & vbNewLine & "The " & siteName & " is up"
'Only send success results if specified
If sendOnFailure = False Then
sendResults = True
End If
Else txtResponse.Text = "There may be a problem with the " & siteName & vbNewLine & "Please verify manually that it is operational." & vbNewLine & "The response received was:" & vbNewLine & "Status Code: " & wResp.StatusCode & " - " & wResp.StatusDescription
sendResults = True
End If
wResp.Close()
End Using
Catch ex As Exception
txtResponse.Text = "There may be a problem with the " & siteName & vbNewLine & "The error returned was:" & vbNewLine & ex.ToString
sendResults = True
End Try
txtLastCheck.Text = Now.ToString("d MMM yyyy HH:mm")
setNextCheck()
End Sub

How can I automatically send email from Thunderbird with Excel VBA?

What I want to do is send an email from a Thunderbird account automatically. The user shouldn't even have to hit the Send button of the email.
I've tried using CDO, but the problem with it is that you have to input the username and password of the account you are sending from. This macro will be used from several different accounts, so inputting each username and password isn't feasible. I could use CDO if there was someway of retrieving the username, password, and smtp server from Thunderbird, but I feel like the code I already have should be able to accomplish this without CDO (hopefully).
Here is really the only code I see (and it's everywhere) in regards to accomplishing this.
Sub Thunderbird()
Dim thund As String
Dim email As String
Dim cc As String
Dim bcc As String
Dim subj As String
Dim body As String
email = "email#test.com"
cc = "cc#test.com"
bcc = "bcc#test.com"
subj = "Subject"
body = "body text"
thund = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird.exe"
thund = thund & " -compose " & Chr$(34) & "mailto:" & email & "?"
thund = thund & "cc=" & Chr$(34) & cc & "?"
thund = thund & "bcc=" & Chr$(34) & bcc & "?"
thund = thund & "subject=" & Chr$(34) & subj & Chr$(34)
thund = thund & "body=" & Chr$(34) & body
Call Shell(thund, vbNormalFocus)
SendKeys "^+{ENTER}", True
End Sub
As of right now, the fields cc, bcc, subj, and body are all recognized correctly. The problem is they all get added to the end of the first field. For instance, with the way the code is right now, cc will get put in the cc field, but bcc, subj, and body all get appended to cc in the cc field of Thunderbird.
If I comment cc out, then bcc is put in the correct field, but subj and body get appended to bcc in the bcc field of Thunderbird.
If I comment cc and bcc out, then subj gets put in the correct field, but body gets appended to subj in the subject field of Thunderbird.
So basically I need to add the correct code at the end of each of these lines. I've tried both "?" and Chr$(34) to no avail.
Lastly, SendKeys "^+{ENTER}", True isn't working at all. This might be because of all the parameters not being put in the correct field of Thunderbird, but not sure since I can't get that working. Email from Thunderbird displays, but this code isn't sending the email like it's supposed to.
SOLUTION (as provided by #zedfoxus)
Sub Thunderbird()
Dim thund As String
Dim email As String
Dim cc As String
Dim bcc As String
Dim subj As String
Dim body As String
email = "email#test.com"
cc = "cc#test.com"
bcc = "bcc#test.com"
subj = "Subject"
body = "body text"
thund = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird.exe" & _
" -compose " & """" & _
"to='" & email & "'," & _
"cc='" & cc & "'," & _
"bcc='" & bcc & "'," & _
"subject='" & subj & "'," & _
"body='" & body & "'" & """"
Call Shell(thund, vbNormalFocus)
Application.Wait (Now + TimeValue("0:00:03"))
SendKeys "^{ENTER}", True
End Sub
You were pretty close. Try this:
Public Sub SendEmail()
Dim thund As String
Dim email As String
Dim cc As String
Dim bcc As String
Dim subj As String
Dim body As String
email = "test#test.com"
cc = "test#test.com"
bcc = "test#test.com"
subj = "Testing"
body = "Testing"
thund = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird.exe " & _
"-compose " & """" & _
"to='" & email & "'," & _
"cc='" & cc & "'," & _
"bcc='" & bcc & "'," & _
"subject='" & subj & "'," & _
"body='" & body & "'" & """"
Call Shell(thund, vbNormalFocus)
SendKeys "^+{ENTER}", True
End Sub
Notice the example from http://kb.mozillazine.org/Command_line_arguments_(Thunderbird).
thunderbird -compose "to='john#example.com,kathy#example.com',cc='britney#example.com',subject='dinner',body='How about dinner tonight?',attachment='C:\temp\info.doc,C:\temp\food.doc'"
The example indicates that after -compose we should use type our information in double-quotes. Each parameter is separated by comma. Nomenclature is parameter='value[,value]' [,parameter='value[,value]]....

Run Script to Append Subject and Body of Email

I am [attempting to] learn how to write a script in Outlook that when a certain category is set on an email:
Append the Subject with " PROJ=5"
Append the Body with about 10 lines of text
Send email.
My goal is to mark an email with a category and forward the email to our ticketing system.
I'm not really having any luck with the samples I have found.
Samples (URL) I have tried (Copied code and updated relevant fields):
slipstick.com
social.technet.microsoft.com
Append the Subject with " PROJ=5"
MailItem.Subject Property Returns a String indicating Outlook item. Read/write.
Example
Item.Subject = "PROJ=5" & Item.Subject
Append the Body with about 10 lines of text
Example
Dim olBody As String
olBody = "<HTML><BODY><P>Append the Body with about 10 lines of text</P>" & vbNewLine & vbNewLine & _
"<P>Append the Body with about 10 lines of text</P></HTML></BODY>" & vbNewLine
olForward.HTMLBody = olBody & vbCrLf & olForward.HTMLBody
Send / Forward Email
Example
'//
Set olForward = Item.Forward
'// add Recipent
olForward.Recipients.Add "email#domain.com"
'// Send or your use .Dispaly
olForward.Send
Run a Script Rule
To use Rule Wizard, your macro has to have the expected parameter:
Example
Public Sub ItemForward(Item As Outlook.MailItem)
End Sub
Helpful article in MSDN Outlook 2010 VBA
Complete Code Test on Outlook 2010 VBA
Please make sure your References are set to run action script (Tools > References)
Option Explicit
'// Run Action Script
Public Sub ItemForward(Item As Outlook.MailItem)
Dim olApp As Outlook.Application
Dim olForward As MailItem
Dim olBody As String
Set olApp = CreateObject("Outlook.Application")
'// Append the Subject
Item.Subject = "PROJ=5 " & Item.Subject
Item.Save
Set olForward = Item.Forward
'// add Recipent
olForward.Recipients.Add "Test#mail.com"
olBody = "<HTML><BODY><P>Append the Body with about 10 lines of text</P>" & vbNewLine & vbNewLine & _
"<P>Append the Body with about 10 lines of text</P>" & vbNewLine & _
"<P>Append the Body with about 10 lines of text</P>" & vbNewLine & _
"<P>Append the Body with about 10 lines of text</P>" & vbNewLine & _
"<P>Append the Body with about 10 lines of text</P>" & vbNewLine & _
"<P>Append the Body with about 10 lines of text</P>" & vbNewLine & _
"<P>Append the Body with about 10 lines of text</P>" & vbNewLine & _
"<P>Append the Body with about 10 lines of text</P>" & vbNewLine & _
"<P>Append the Body with about 10 lines of text</P>" & vbNewLine & _
"<P>Append the Body with about 10 lines of text</P></HTML></BODY>" & vbNewLine
'// Forward Email
olForward.HTMLBody = olBody & vbCrLf & olForward.HTMLBody
'// Send or your use .Dispaly
olForward.Send
Set olApp = Nothing
Set olForward = Nothing
End Sub