Send email containing text and ics file to Outlook - vb.net

I want to send an email containing some text in the body and a .ics calendar file attachment. This is some test code:
Dim strAppointment As New System.Text.StringBuilder
strAppointment.Append("BEGIN:VCALENDAR" & vbCrLf)
strAppointment.Append("VERSION:2.0" & vbCrLf)
strAppointment.Append("CALSCALE:GREGORIAN" & vbCrLf)
strAppointment.Append("PRODID:ExcelDent" & vbCrLf)
strAppointment.Append("METHOD:REQUEST" & vbCrLf)
strAppointment.Append("BEGIN:VEVENT" & vbCrLf)
strAppointment.Append("DTSTART:20230219T140000Z" & vbCrLf)
strAppointment.Append("DTEND:20230219T170000Z" & vbCrLf)
strAppointment.Append("DTSTAMP:" & Now.ToUniversalTime().ToString("yyyyMMddTHHmmssZ" & vbCrLf))
strAppointment.Append("SUMMARY:Dental Appointment" & vbCrLf)
strAppointment.Append("DESCRIPTION:Appointment with Dr Doe" & vbCrLf)
strAppointment.Append("LOCATION:8888 address of the clinic" & vbCrLf)
strAppointment.Append("ORGANIZER;CN=DentalOffice1:MAILTO:me#me.com" & vbCrLf)
strAppointment.Append("ATTENDEE;PARTSTAT=ACCEPTED;RSVP=False;CN=Mike;ROLE=REQ-PARTICIPANT:MAILTO:TheRecipient#whatever.com" & vbCrLf)
strAppointment.Append("UID:MyTest1" & vbCrLf)
strAppointment.Append("SEQUENCE:1" & vbCrLf)
strAppointment.Append("STATUS:CONFIRMED" & vbCrLf)
strAppointment.Append("END:VEVENT" & vbCrLf)
strAppointment.Append("END:VCALENDAR" & vbCrLf)
Dim strHeader As New System.Text.StringBuilder
strHeader.Append("Content-Type: text/calendar; charset=utf-8; method=REQUEST; name=invite.ics" & vbCrLf)
strHeader.Append("Content-Transfer-Encoding: base64" & vbCrLf)
strHeader.Append("Content-Disposition: attachment; filename=invite.ics" & vbCrLf)
Sending the ICS file via email to gmail and Yahoo for instance is no issue as both are recognizing and processing the ICS file correctly. But when the email is received on an Outlook application, all we see is the ICS file in attachment, no email body whatsoever. Sure if the recipient clicks on the attachment, the appointment gets added to the calendar. But the point is that the email looks really unprofessional and downright fishy. I've seen a lot of posts which discuss this topic but I haven't seen a solution. It would be great to compare to a properly formatted email which has been proven to work. If this issue rings a bell for anyone, I'd really appreciate getting some pointers.
Thanks everyone !

Related

Sending meeting requests using ical through outlook

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)

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]]....

How to post a forum topic with attachment to IBM Connections using Excel VBA

I am trying to post a forum topic with attached image file to IBM Connections 5.0 using Excel VBA.
According to IBM Connections API description a multipart request will be required here.
What I already managed is to post a forum topic without attachment and also attaching a text or image file to an existing wiki page. Therefore I assume that the problem is not related with these aspects but rather with the correct formatting of the multipart request. API description is not very clear to me here and I tried several things I found about multipart requests in other help forums. But all I get is a response "400 bad request".
Maybe some of you experts can give me a hint about my code:
Public Sub CreateForumPost()
Const sBoundary As String = "2588eb82-2e1c-4aec-9f4f-d65a3ecf8fab"
Dim oHttp As MSXML2.xmlhttp
Dim sUrl As String
Dim sBody As String
'create XMLHTTP object and URL
Set oHttp = CreateObject("MSXML2.XMLHTTP")
sUrl = "https://my-connect-server/forums/atom/topics?forumUuid=9e51cbfb-4b1d-405d-9835-dbd087c49a65"
'create forum post
sBody = "--" & sBoundary & vbCrLf
sBody = sBody & "<?xml version=""1.0"" encoding=""UTF-8""?>"
sBody = sBody & "<entry xmlns=""http://www.w3.org/2005/Atom"" xmlns:app=""http://www.w3.org/2007/app"" xmlns:snx=""http://www.ibm.com/xmlns/prod/sn"">"
sBody = sBody & "<category scheme=""http://www.ibm.com/xmlns/prod/sn/type"" term=""forum-topic""/>"
sBody = sBody & "<title type=""text""> " & "My Title" & " </title>"
sBody = sBody & "<category term=""question"" scheme=""http://www.ibm.com/xmlns/prod/sn/flags""/>"
sBody = sBody & "<category term=""" & "my-tag" & """/>"
sBody = sBody & "<content type=""html""> " & "My post content" & " </content>"
sBody = sBody & "</entry>" & vbCrLf
sBody = sBody & "--" & sBoundary & vbCrLf
sBody = sBody & "Content-Disposition: attachment; filename=""dummy.txt""" & vbCrLf & vbCrLf
sBody = sBody & sGetFile("c:\temp\dummy.txt") & vbCrLf
sBody = sBody & "--" & sBoundary & "--" & vbCrLf
Call oHttp.Open("POST", sUrl, False)
Call oHttp.setRequestHeader("Content-Type", "multipart/related;boundary=" & sBoundary & ";type=""application/atom+xml""")
Call oHttp.send(pvToByteArray(sBody))
If oHttp.Status = 201 Then
Call MsgBox("success")
Else
Call MsgBox("error")
Stop
End If
End Sub
Private Function sGetFile(sName As String) As String
Dim abyContent() As Byte
Dim iNumber As Integer
Dim lLen As Long
lLen = FileLen(sName)
If lLen > 0 Then
ReDim abyContent(lLen - 1)
iNumber = FreeFile
Open sName For Binary Access Read As iNumber
Get iNumber, , abyContent
Close iNumber
sGetFile = StrConv(abyContent, vbUnicode)
Else
sGetFile = ""
End If
End Function
Function pvToByteArray(sText As String) As Byte()
pvToByteArray = StrConv(sText, vbFromUnicode)
End Function
We found out what the problem was. It was indeed about the formatting of the multipart request. You need to be very careful with the CrLf characters ...
Public Sub CreateForumPost()
'...
'create forum post
sBody = vbCrLf & "--" & sBoundary & vbCrLf & vbCrLf
'...
sBody = sBody & sGetFile("c:\temp\dummy.txt") & vbCrLf
sBody = sBody & "--" & sBoundary & "--"
'...
End Sub
Now it works. Nevertheless many thanks for your support!

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

Detect response from Modem?

I'm working with a Teltonika G10 GSM modem and wrote up a basic program to send out SMS. I put a 1.5 second timer between each AT command to allow the modem to simulate the wait for the "OK" from the modem. This works for now but I'd rather use a branching statement wait for an actual response such as "OK" or "ERROR" rather than using a timer.
SerialPort1.Write("AT+CMGD=1,4" & vbCrLf)
Thread.Sleep(1250)
SerialPort1.Write("AT+CMGF=1" & vbCrLf)
Thread.Sleep(1250)
SerialPort1.Write("AT+CMGS=" & Chr(34) & "3475558223" & Chr(34) & vbCrLf)
Thread.Sleep(1250)
SerialPort1.Write(":|" & Chr(26))
I was new to programming with AT commands and had spent a good deal of time with Putty to get an understanding of it. Hans Passant suggeested to use .ReadLine() and it's worked great.
Below is a sample of code that's worked great. It basically submits a command to the modem and will only continue if the modem responds with an "OK".
If modem.IsOpen() Then
modem.Write("AT+CMGD=" & Chr(34) & "ALL" & Chr(34) & vbCrLf) 'deletes last received message
'Sets Modem to Text
While (modem.ReadLine().ToString <> "OK")
modem.Write("AT+CMGF=1" & vbCrLf)
End While
While (modem.ReadLine().ToString <> "OK")
modem.Write("AT+CSMP=17,167,0,0" & vbCrLf)
End While
While (modem.ReadLine().ToString <> "OK")
modem.Write("AT+CNMI=1,1,0,0,0" & vbCrLf)
End While
End If