I have followed the instructions for MailKit by Jeffrey Stedfast at MimeKit.net with further input from his helpful response to another Stack Overflow question to create an email with an embedded image. The result is that it saves space for the image but places the image at the end of the email as an attachment. Here is the code:
Dim clsSMTP = New MailKit.Net.Smtp.SmtpClient
clsSMTP.Connect("smtp.gmail.com", 587, False)
clsSMTP.Authenticate("xxxxxxxx#gmail.com", "xxxxxxxxxx")
strMessage = "<!DOCTYPE html><html><body style='font-family:Verdana,Arial,Tahoma,Calibri,Neue Helvetica;font-size:11pt;font-weight:normal;font-style:italic'>" _
& "<table><tr><td style='width:300px'><img src='cid:mptIntro.ContentId' style='width:300px'/></td><td> </td>" _
& "<td><h1 style='font-size:16pt;font-weight:bold;'>Time for an Advent Study</h1></td></tr></table>"
bdyBuild = New BodyBuilder
strPathIntro = "C:/Users/xxx/xxxxx/Images/xxxxxxxxxx.jpg"
mptIntro = bdyBuild.LinkedResources.Add(strPathIntro)
mptIntro.ContentId = MimeKit.Utils.MimeUtils.GenerateMessageId()
mptIntro.ContentDisposition = New MimeKit.ContentDisposition(MimeKit.ContentDisposition.Inline)
strMember = "Me"
strAttendeeEmail = "me#att.net"
Dim mmgSpecial As New MimeMessage()
mmgSpecial.From.Add(New MailboxAddress("xxx xxxxx xxxxx", "xxxxxxxxx#gmail.com"))
mmgSpecial.To.Add(New MailboxAddress(strMember, strAttendeeEmail))
mmgSpecial.Subject = "Study Ideas"
bdyBuild.HtmlBody = strMessage
mmgSpecial.Body = bdyBuild.ToMessageBody()
clsSMTP.Send(mmgSpecial)
Thank you for any help.
Related
I am trying to create a calendar file (.ics) using ical.net in my vb application. My application requires appointments to be approved first. On appointment creation they are marked as pending, then when approved, it updates to Approved.
I have no issue creating the appointment or cancelling the appointment, just updating it. My appointments have both required and optional attendees. I can't figure out how to get this to work. My update ics file just adds it as a new appointment. The UID is the same in both files.
I think it has something to do with METHOD maybe, not sure. If I use PUBLISH, I can add it to my outlook calendar when I open the ICS file, but in the update ics file it just adds it as new. If I use REQUEST, it doesn't get added to my calendar. When I open it, it just has the remove option. These files will ONLY be used in outlook.
Here is my code to generate the ics file:
Public Shared Function createoutlookappt(ByVal br As benchrequest, Optional ByVal type As String = Nothing) As String
Dim recurrence As RecurrencePattern = Nothing
If Not String.IsNullOrEmpty(br.recurrinfo) Then
Dim helper As RecurrenceInfoXmlPersistenceHelper = New RecurrenceInfoXmlPersistenceHelper(New RecurrenceInfo())
Dim recInfo As RecurrenceInfo = CType(helper.FromXml(br.recurrinfo), RecurrenceInfo)
recurrence = New RecurrencePattern With {
.FirstDayOfWeek = recInfo.FirstDayOfWeek,
.Frequency = CType([Enum].Parse(GetType(FrequencyType), recInfo.Type.ToString), FrequencyType),
.Count = recInfo.OccurrenceCount,
.Until = recInfo.End,
.Interval = recInfo.Periodicity
}
End If
Dim e = New CalendarEvent
With e
.Start = New CalDateTime(CDate(br.start_time))
.[End] = New CalDateTime(CDate(br.end_time))
.DtStamp = New CalDateTime(DateTime.Now)
.Location = br.bench_name
.Priority = br.priority
.Uid = br.uid.ToString
.Sequence = CInt(br.seq)
If Not String.IsNullOrEmpty(br.allday) Then
.IsAllDay = CBool(br.allday)
End If
.LastModified = New CalDateTime(Now)
.Description = br.notes
.Summary = "(" & br.labeltxt & ") Bench Request (ID-" & br.request_id & "): " & br.program_name & " - " & br.project_name & " - " & br.activity
.RecurrenceRules = New List(Of RecurrencePattern)() From {recurrence}
.Class = "PUBLIC"
.Transparency = TransparencyType.Opaque
.Organizer = New Organizer() With {.Value = New Uri("mailto:" & br.requesting_user_email)}
End With
'Add attendees
Dim dt As New DataTable
Dim ta As New BSDataSetTableAdapters.getUserRequestTableAdapter
dt = ta.GetData(br.request_id, "T")
Dim attendee As Attendee
For Each row As DataRow In dt.Rows
If row("type") = "Required" Then
attendee = New Attendee With {
.CommonName = (row("last_name") & ", " & row("first_name")).ToString,
.Rsvp = True,
.Value = New Uri("mailto:" & row("email").ToString),
.Role = "REQ-PARTICIPANT"
}
e.Attendees.Add(attendee)
ElseIf row("type") = "Optional" Then
attendee = New Attendee With {
.CommonName = (row("last_name") & ", " & row("first_name")).ToString,
.Rsvp = False,
.Role = "OPT-PARTICIPANT",
.Value = New Uri("mailto:" & row("email").ToString)
}
e.Attendees.Add(attendee)
End If
Next
Dim calendar = New Calendar()
Select Case type
Case "Deny"
calendar.Method = "CANCEL"
Case "Approved"
calendar.Method = "PUBLISH"
Case "New Request"
calendar.Method = "PUBLISH"
Case Else
calendar.Method = "PUBLISH"
End Select
calendar.Events.Add(e)
Dim serializer = New CalendarSerializer()
Dim serializedCalendar = serializer.SerializeToString(calendar)
Dim bytesCalendar = Encoding.ASCII.GetBytes(serializedCalendar)
Dim ms As MemoryStream = New MemoryStream(bytesCalendar)
Dim filename As String = Path.GetTempPath & br.request_id & ".ics"
Dim file As New FileStream(filename, FileMode.Create, FileAccess.Write)
ms.WriteTo(file)
file.Close()
ms.Close()
Return filename
End Function
This is the initial ics file for creating the meeting:
BEGIN:VCALENDAR
METHOD:PUBLISH
PRODID:-//github.com/rianjs/ical.net//NONSGML ical.net 4.0//EN
VERSION:2.0
BEGIN:VEVENT
ATTENDEE;CN="K, David";RSVP=TRUE;ROLE=REQ-PARTICIPANT:mailto:david.k#outlook.com
CLASS:PUBLIC
DESCRIPTION:testing ical
DTEND:20220406T110000
DTSTAMP:20220323T115745
DTSTART:20220406T080000
LAST-MODIFIED:20220323T115745
LOCATION:Test Bench 1
ORGANIZER:mailto:david.k#outlook.com
PRIORITY:3
RRULE:FREQ=WEEKLY;INTERVAL=2;UNTIL=20220525T110000;WKST=SU;COUNT=4
SEQUENCE:0
SUMMARY:(PENDING) Bench Request (ID-35): Dave Test Program - Test Project
- Bench Maintainance
TRANSP:OPAQUE
UID:ddc29fe7-12bf-4f7d-bb13-48989433c605
END:VEVENT
END:VCALENDAR
This is my update file output:
BEGIN:VCALENDAR
METHOD:PUBLISH
PRODID:-//github.com/rianjs/ical.net//NONSGML ical.net 4.0//EN
VERSION:2.0
BEGIN:VEVENT
ATTENDEE;CN="K, David";RSVP=TRUE;ROLE=REQ-PARTICIPANT:mailto:david.k#outlook.com
CLASS:PUBLIC
DTEND:20220406T110000
DTSTAMP:20220323T120932
DTSTART:20220406T080000
LAST-MODIFIED:20220323T120932
LOCATION:Test Bench 1
ORGANIZER:mailto:david.k#outlook.com
PRIORITY:0
RRULE:FREQ=WEEKLY;INTERVAL=2;UNTIL=20220525T110000;WKST=SU;COUNT=4
SEQUENCE:0
SUMMARY:(Approved) Bench Request (ID-35): Dave Test Program - Test Project
- Bench Maintainance
TRANSP:OPAQUE
UID:ddc29fe7-12bf-4f7d-bb13-48989433c605
END:VEVENT
END:VCALENDAR
This is my cancel file output:
BEGIN:VCALENDAR
METHOD:CANCEL
PRODID:-//github.com/rianjs/ical.net//NONSGML ical.net 4.0//EN
VERSION:2.0
BEGIN:VEVENT
ATTENDEE;CN="K, David";RSVP=TRUE;ROLE=REQ-PARTICIPANT:mailto:david.k#outlook.com
CLASS:PUBLIC
DTEND:20220406T110000
DTSTAMP:20220323T121655
DTSTART:20220406T080000
LAST-MODIFIED:20220323T121655
LOCATION:Test Bench 1
ORGANIZER:mailto:david.k#outlook.com
PRIORITY:0
SEQUENCE:1
SUMMARY:(Denied) Bench Request (ID-35): Dave Test Program - Test Project -
TRANSP:OPAQUE
UID:ddc29fe7-12bf-4f7d-bb13-48989433c605
END:VEVENT
END:VCALENDAR
What am I doing wrong. I have search and read many different posts and alike and nothing has worked.
My end goal. A user creates an appointment in my application where it is marked as pending. A ics file is created where they can add the appointment to their outlook calendar. An email is generated to the approvers. Once the manger goes in an approves it, an email is sent to the user letting them know it is approved (or denied) with an ics file attachment to update the appointment on their calendar (or remove it if denied). There could also be a situation where the date, time changes, so I would need to have those updates as well.
Sorry for the long post, wanted to provide as much info as possible. Thanks in advance
I have a dataset that contains multiple values. I want to take those rows from that dataset that contains "the specific value" and firstly I want to display those in a MessageBox.
Furtheron, I try to view them in a datagridview called ErrorsDgV.
I already searched this topic and found a good function, but unfortunately, all I get from the MessageBox is an empty box.
ErrorsDgV.DataSource = Srchdataset.Tables("blubb")
LineLabel.Text = "Lines: " &
Srchdataset.Tables("blubb").Rows.Count.ToString
ErrorsDgV.Sort(ErrorsDgV.Columns(1), System.ComponentModel.ListSortDirection.Ascending)
ErrorsDgV.AutoSizeColumnsMode = DataGridViewAutoSizeColumnsMode.AllCells
ErrorsDgV.Columns(1).DefaultCellStyle.Format = "dd/MM/yyyy HH:mm:ss.fff"
Dim answer As String = ""
Dim SearchRows() As Data.DataRow
SearchRows = Srchdataset.Tables("blubb").Select("Data = 'the specific value'")
answer = ""
For k As Integer = 0 To SearchRows.Length - 1
If answer = "" Then
answer = SearchRows(k).Item("Data")
Else
answer = answer & vbNewLine & SearchRows(k).Item("Data")
End If
Next
MsgBox(" " & answer)
I debugged also and got to know that SearchRows is empty, even if the specific value is inlcuded in that DataSet.
I don't know a lot about the subject of sorting but here goes: I am trying to sort a music library (comma seperated in a csv file. Some examples):
1,Sweet Home Alabame,Lynyrd Skynyrd,4:40,Classic Rock
2,Misirlou,Dick Dale,2:16,Surf Rock
I need to sort them alphabetically (by title of track) but I don't know two things: 1. Why my current technique isn't working:
Dim array() As String = {}
sr = New StreamReader("library.csv")
counter = 1
Do Until sr.EndOfStream
array(counter) = sr.ReadLine()
counter += 1
Loop
System.Array.Sort(Of String)(array)
Dim value As String
For Each value In array
Console.WriteLine(value)
Next
Console.ReadLine()
I don't know if this is the best way of sorting. I then need to display them as well. I can do this without sorting, but can't figure out how to do it with sorting.
Help please (from people who, unlike me, know what they're doing).
Right now you're putting all fields in one long string of text (each row).
In order to sort by a particular field, you'll need to build a matrix of rows and columns. For example, a DataTable.
Here's a class that should do the trick for you:
https://www.codeproject.com/Articles/11698/A-Portable-and-Efficient-Generic-Parser-for-Flat-F
Here's the sample usage code from the article, translated to VB:
Public Class CsvImporter
Public Sub Import()
Dim dsResult As DataSet
' Using an XML Config file.
Using parser As New GenericParserAdapter("MyData.txt")
parser.Load("MyData.xml")
dsResult = parser.GetDataSet()
End Using
' Or... programmatically setting up the parser for TSV.
Dim strID As String, strName As String, strStatus As String
Using parser As New GenericParser()
parser.SetDataSource("MyData.txt")
parser.ColumnDelimiter = vbTab.ToCharArray()
parser.FirstRowHasHeader = True
parser.SkipStartingDataRows = 10
parser.MaxBufferSize = 4096
parser.MaxRows = 500
parser.TextQualifier = """"c
While parser.Read()
strID = parser("ID")
strName = parser("Name")
' Your code here ...
strStatus = parser("Status")
End While
End Using
' Or... programmatically setting up the parser for Fixed-width.
Using parser As New GenericParser()
parser.SetDataSource("MyData.txt")
parser.ColumnWidths = New Integer(3) {10, 10, 10, 10}
parser.SkipStartingDataRows = 10
parser.MaxRows = 500
While parser.Read()
strID = parser("ID")
strName = parser("Name")
' Your code here ...
strStatus = parser("Status")
End While
End Using
End Sub
End Class
There's also this from here, demonstrating DataTable usage:
Dim csv = "Name, Age" & vbCr & vbLf & "Ronnie, 30" & vbCr & vbLf & "Mark, 40" & vbCr & vbLf & "Ace, 50"
Dim reader As TextReader = New StringReader(csv)
Dim table = New DataTable()
Using it = reader.ReadCsvWithHeader().GetEnumerator()
If Not it.MoveNext() Then
Return
End If
For Each k As var In it.Current.Keys
table.Columns.Add(k)
Next
Do
Dim row = table.NewRow()
For Each k As var In it.Current.Keys
row(k) = it.Current(k)
Next
table.Rows.Add(row)
Loop While it.MoveNext()
End Using
And this Q&A illustrates how to sort the DataTable by a given column.
Hi i am new to VB and in the process of learning. This error occur sometimes and doesn't occur sometimes which i find it weird.
I receive the error Index was outside the bounds of the array, that points to Button30.Text = Split(newestversion, vbCrLf)(**1**)
My motive is to read line by line from a online hosted text file.
For example,
label1.text = line 1 of the text file
label2.text = line 2 of the text file
This is very much what i want.
Here is my current code (EDITED):
Dim request As System.Net.HttpWebRequest = System.Net.HttpWebRequest.Create("direct link to my online txt file")
Dim response As System.Net.HttpWebResponse = request.GetResponse
Dim sr As System.IO.StreamReader = New System.IO.StreamReader(response.GetResponseStream)
Dim stringReader As String
stringReader = sr.ReadLine()
Button10.Text = stringReader
Dim newestversion As String = sr.ReadToEnd
Dim currentversion As String = Application.ProductVersion
Dim part() As String = Split(newestversion, vbCrLf)
If part.Length < 10 Then
' not enough items in the array. You could also throw and exception or do some other stuff here
Label10.Text = "beta"
Exit Sub
End If
'updates new episode numbers on buttons
Button20.Text = part(0)
Button30.Text = part(1)
Button40.Text = part(2)
Button50.Text = part(3)
Button60.Text = part(4)
Button70.Text = part(5)
Button80.Text = part(6)
Button90.Text = part(7)
Button100.Text = part(8)
Button110.Text = part(9)
End If
Thank You!!
You split your String for line breaks. This gives you an array, having one entry for each line in the String. However, you do not check if this array holds the amount of items you expect. You could do:
Dim newestversion As String = sr.ReadToEnd
Dim currentversion As String = Application.ProductVersion
Dim part() As String = Split(newestversion, vbCrLf)
If part.Length < 10 Then
' not enough items in the array. You could also throw and exception or do some other stuff here
MsgBox(String.Format("Array only has {0} items", part.Length))
Exit Sub
End If
'updates new episode numbers on buttons
Button20.Text = part(0)
Button30.Text = part(1)
Button40.Text = part(2)
...
Edit for the updated question
If you do have a problem like this, just approach it systematically and get as much information as you can. First you have to check if you really get the data you want from the remote source. To do that, add some logging (e.g. a MsgBox(newestversion) or a real log file). Check if the data you get is what you expect. If not, there's already a problem with your request/response code, which is a completely different problem than what I provided a solution for. If newestversion is OK, check if the splitting works by printing out the part() array. Maybe the server uses a different operating system or just uses vbCr as newline and not vbCrlf. If the splitting also works, you are done.
I have a tool that capture screenshots of the application that we test at our workplace. Now once I complete my testing of a particular test case or scenarios, we attach the screenshot that we have taken to HP Quality Center manually.
I want to automate this and make my tool to upload the word document to a test in QC Test Lab. Is this possible? If Yes, How can we do this in Excel VBA?
Operations that we need to perform would be as below:
Connect to QC project with login credentials, domain & project details
Pick a file(s) from a local folder
Upload a file(s) to QC Test Lab, specific test case
I used the below code, but getting error in that code. I marked it in the code below, please check below :
Dim intTestID, FldPath, TestSetName, i
Dim TestSetFact, tsTreeMgr, tSetFolder, TestSetsList, theTestSet
Dim TestSetIdentifier, TSTestFact, TestSetTestsList, testInstanceF, aFilter
Dim lst, tstInstance
intTestID = "8968"
FldPath = TextBox3.Text '"Root\ProjFold\Release1\BRD"
TestSetName = ComboBox3.Text '"BRD" '
Set Connection = CreateObject("TDApiOle80.TDConnection")
Connection.InitConnectionEx Sheet2.Range("B1").Value2
Connection.Login TextBox1.Text, TextBox2.Text
Connection.Connect ComboBox1.Text, ComboBox2.Text
Set TestSetFact = Connection.TestSetFactory
Set tsTreeMgr = Connection.TestSetTreeManager
Set tSetFolder = tsTreeMgr.NodeByPath(FldPath)
Set TestSetsList = tSetFolder.FindTestSets(TestSetName)
Set theTestSet = TestSetsList.Item(1)
TestSetIdentifier = theTestSet.ID
i = 0
Set TSTestFact = theTestSet.TSTestFactory
Set TestSetTestsList = TSTestFact.NewList("")
Set testInstanceF = Connection.TSTestFactory
Set aFilter = testInstanceF.Filter
aFilter.Filter("TC_TEST_ID") = intTestID
Set lst = testInstanceF.NewList(aFilter.Text)
Set tstInstance = lst.Item(1) <---------------- getting error here
MsgBox (tstInstance.Field("TS_Name"))
'tstInstance.Status = "Failed"
'tstInstance.Field("TC_STATUS") = Item1.Status '"Passed"
'tstInstance.Post
Dim RunF, runName, NewRun, runStepF, runlst, Item1, runStep2
MsgBox (tstInstance.Field("TS_Subject"))
Set RunF = tstInstance.RunFactory
runName = "Run_" & Month(Date) & "-" & Day(Date) & "_" & Hour(Now) & "-" & Minute(Now) & "-" & Second(Now)
Set NewRun = RunF.AddItem(Null)
NewRun.Status = "Passed"
NewRun.Name = runName
NewRun.Post
NewRun.CopyDesignSteps
NewRun.Post
Set runStepF = NewRun.StepFactory
Set runlst = runStepF.NewList("")
For Each Item1 In runlst
Set runStep2 = Item1
runStep2.Status = "Passed" '
runStep2.Field("ST_ACTUAL") = "As Expected"
runStep2.Post
Next
'tstInstance.Refresh
tstInstance.Status = "Failed"
tstInstance.Post
Connection.DisconnectProject
Connection.ReleaseConnection
'Set QC = Nothing
Set Connection = Nothing
The error is occurring because the array of objects is not returning. You need to check if the Filter gives you a list of results before assuming that lst.Item(1) exists.
For instance:
If lst.Count > 0 Then Set tstInstance = lst.Item(1)