How to Add Text to a VB.NET RadioButtonList - vb.net

I'm dynamically creating a RadioButtonList and can't figure out how to add additional text to show up under the radio button.
My basic code is as follows and I want sURL to show up under each resultant radio button.
For i As Integer = 0 To ds.Tables(0).Rows.Count - 1
Dim iLocationID As Integer = ds.Tables(0).Rows(i).Item("LocationID")
Dim sStreet As String = ds.Tables(0).Rows(i).Item("AddressStreet")
Dim sCity As String = ds.Tables(0).Rows(i).Item("AddressCity")
Dim sState As String = ds.Tables(0).Rows(i).Item("AddressState")
Dim sZip As String = ds.Tables(0).Rows(i).Item("AddressPostalCode")
Dim sName as String = ds.Tables(0).Rows(i).Item("Name")
Dim dsContact As New DataSet
Dim sURL As String = ""
sURL = "<a href='http://www.google.com/maps?f=q&source=s_q&hl=en&geocode=&q=" & sStreet & "+" & sState & "+" & sZip & "' target='_blank'>" & sStreet & " " & sCity & " " & sState & ", " & sZip & "</a>"
Dim dDistance As Decimal = Math.Round(ds.Tables(0).Rows(i).Item("Distance"), 1)
Dim sDistance As String
If dDistance > 1 Then
sDistance = dDistance & " Miles Away"
Else
sDistance = dDistance & " Mile Away"
End If
sURL += " " & sDistance
sURL += " Phone: " & sContactPhone
rblVendorLocations.Items.Add(New ListItem(sName, iLocationID))
Next

The first parameter to the ListItem constructor is the text to show beside the radio button, if you want that to be sURL then pass that rather than sName.
You can also pass html as this parameter if you want to style it in some particular way e.g.
ListDeliveryFrequency.Items.Add( _
New ListItem("<div>" + sName +"</div> <div>" + sUrl + "</div>", _
iLocationID))

Related

VBA/Access: How to stop "You... FORM to be active window"

I want to be able to tell IF a form is the active window.
It seems simply invoking that method produces an error. I guess I could catch that error and run with it, but it's a backwards way of doing it.
Screen.ActiveForm.Name
This needs a form to be active. If I am breaking any rules of stackOverflow please be kind and remind me as I am new to forum.
Screen.parent, screen.activeControl, etc. What if VBA editor is open, as often it is?
Function CStatus(strStatus, ByRef intType As Integer, Optional ByRef erNo, Optional erMsg, Optional strDatum)
'pXname = "CStatus"
'pXStack = Left(pXStack, 500) & ">" & pXname
'Updates and manages the status bar
Dim strPreamble As String, strOut As String, strForm As String, strComment As String, strSQL As String, strPxStack As String, strCErrStack As String
Dim intColor As Double
Dim intPreLen As Integer
'On Error GoTo err_hand
'Color Codes
'12632256 = Lt Grey
'33023 = Orange
'65280 = Green
'16744576 = Steel Grey
'Define "Constants"
intPreLen = 350 'Length of previous message cache
'** Fix missings
If (IsMissing(strDatum) = True) Then strDatum = "[N/A]"
'** Other inits
strWindow = Screen.Parent.Name
strForm = Screen.ActiveForm.Name
'** intDebug ' Minimum Level of to report to status
'bEcho = True 'Whether to echo to status
intColor = errNoColor(intType)
'Error-level idiot explanations
strComment = "0"
If IsMissing(erNo) Then erNo = 0
If (IsNull(erMsg) = False) Then
If IsMissing(erMsg) = False Then strComment = erMsg
End If
strComment = errorTree(erNo)
strPreamble = Left(strPreamble, intPreLen) & "..."
strErrStack = Left(strErrStack, intPreLen) & " > " & pXname & ":" & intType
strCErrStack = strErrStack
reS:
If ((strForm = "finvmain") Or (strForm = "fclips")) Then Screen.ActiveForm.timeStatusUpdated = Now() 'Small field keeps time
If bEcho = True Then
strPxStack = ""
strCErrStack = "" 'Internal error stack
End If
strOut = Now() & " " & intType & " (" & strType & "): " & erNo & " " & strCErrStack & " >> " & strComment & " / " & strStatus & " [" & strDatum & "] .. " & strPreamble
If bEcho = True Then
If (strForm = "fInvMain") Then Screen.ActiveForm.txtStatus2 = Screen.ActiveForm.txtStatus 'Added second window to show previous message
Screen.ActiveForm.txtStatus = strOut
End If
Screen.ActiveForm.txtStatus.ForeColor = intColor
If strForm = "fInvMain" Then strTag = Screen.ActiveForm.Controls("txttag").value
'***Event Log
If erNo = "" Then erNo = 0
If IsMissing(erMsg) = True Then erMsg = ""
If IsMissing(strDatum) = True Then strDatum = ""
If Len(strPreamble) < 2 Then strPreamble = "[None]"
'Fixxed - Syntax Error for Some Odd Reason! Apr 27th
If ((strTag = Empty) And (strForm = "fInvMain")) Then strTag = Screen.ActiveForm.txtTag 'Attempt to add tag# to entry
strStatus = cleanString(strStatus)
strDatum = cleanString(strDatum)
strComment = cleanString(strComment)
strSQL = "INSERT INTO tEvents(txtdate, myerrno, interrno, myerrmsg, interrmsg, txtform, stack, process, Datum, idLink) VALUES ('" & Now() & "','" & intType & "','" & erNo & "','" & strStatus & "','" & strComment & "','" & strForm & "','" & strErrStack & "','" & pXname & "','" & strDatum & "','" & strTag & "');"
CurrentDb.Execute strSQL, dbFailOnError
Exit Function
err_hand:
If Err.Number = 2475 Then
bEcho = False
Resume reS
Else: MsgBox "555: CStatus Internal Error, Turn off error handling to view"
End If
End Function
I need a boolean true or false IF form is active. If it isn't, I can't put stuff into a textbox in that.
To determine if a particular form is open then set focus to form:
If CurrentProject.AllForms("finvmain").IsLoaded
strForm = "finvmain"
Elseif CurrentProject.AllForms("fclips").IsLoaded Then
strForm = "fclips"
End If
If strForm <> "" Then DoCmd.SelectObject acForm, strForm

Can't Update Values In Microsoft Access

I have a problem that when I try updating data the the program doesn't save it in the database.
This is the current code:
Dim y As Byte = Convert.ToByte(lblID.Text) - 1
Dim cb As New OleDb.OleDbCommandBuilder(da)
ds.Tables("dset").Rows(y).Item(1) = txtname.Text
ds.Tables("dset").Rows(y).Item(2) = txtsubm.Text & "/" & txtsubd.Text & "/" & txtsuby.Text
ds.Tables("dset").Rows(y).Item(3) = txtexpm.Text & "/" & txtexpd.Text & "/" & txtexpy.Text
ds.Tables("dset").Rows(y).Item(5) = txtnotes.Text
If MdComboBox1.SelectedItem = "A" Then
ds.Tables("dset").Rows(y).Item(4) = "A"
ElseIf MdComboBox1.SelectedItem = "B" Then
Else
MdAlertBox1.Text = "Please Select A Class The Class Box"
MdAlertBox1.Visible = True
End If
MdAlertBox1.Text = "Data Sucessfully Updated !"
MdAlertBox1.kind = MDAlertBox._Kind.Success
MdAlertBox1.Visible = True
getinfo.Start()
updatedata.Stop()
And the declared variables:
Dim conn As New OleDb.OleDbConnection
Dim DbProv As String = "PROVIDER=microsoft.ACE.OLEDB.12.0;"
Dim Src As String = " data source = c:\users\kingo\documents\visual studio 2013\Projects\WindowsApplication2\WindowsApplication2\BigGymDB.accdb"
Dim da As OleDb.OleDbDataAdapter
Dim ds As New DataSet
Put a debug.print to see the values you are passing to the Database. Like this:
ds.Tables("dset").Rows(y).Item(2) = txtsubm.Text & "/" & txtsubd.Text & "/" & txtsuby.Text
ds.Tables("dset").Rows(y).Item(3) = txtexpm.Text & "/" & txtexpd.Text & "/" & txtexpy.Text
ds.Tables("dset").Rows(y).Item(5) = txtnotes.Text
'your code ---^
debug.print txtname.Text; txtsubm.Text & "/" & txtsubd.Text & "/" & txtsuby.Text;
debug.print txtnotes.Text; txtexpm.Text & "/" & txtexpd.Text & "/" & txtexpy.Text
'your code ---v
If MdComboBox1.SelectedItem = "A" Then
ds.Tables("dset").Rows(y).Item(4) = "A"
ElseIf MdComboBox1.SelectedItem = "B" Then
Then in two lines in the Immdiate Window, you should see whether these txtsub.Text and the other 3 inputs actually have something.

vbtab issue in a do until loop in vb.net

hey guys i am having a problem in my application with the vbtab
can anyone know what is the problem
this is my code:
txtshowpayments.Text = "Student's ID" & vbTab & "Student's Name" & vbTab & "Total Payment" & vbCrLf
Class217FileReader = New StreamReader("class217.txt")
PaymentsFileReader = New StreamReader("payments.txt")
Do Until PaymentsFileReader.EndOfStream
Do Until Class217FileReader.EndOfStream
Dim aline As String = Class217FileReader.ReadLine
Dim aline1 As String = PaymentsFileReader.ReadLine
Dim fields() As String = aline.Split(","c)
Dim fields1() As String = aline1.Split(","c)
Dim StudentId As Integer = Convert.ToInt32(fields1(0))
Dim studentId1 As Integer = Convert.ToInt32(fields(0))
Dim StudentName As String = fields(1) & " " & fields(2)
Dim totalpayment As Integer = Convert.ToInt32(fields1(1)) + Convert.ToInt32(fields1(2)) + Convert.ToInt32(fields1(3))
If ShouldDisplay(StudentId, studentId1) Then
txtshowpayments.Text &= StudentId & vbTab & StudentName & vbTab & String.Format("{0:C}", totalpayment) & vbCrLf
End If
Loop
Loop
Thank you for the help
Use a Format String:
Dim formatString As String = "{0,-12} {1,-14} {2}" & vbCrLf
txtshowpayments.Text = String.Format(formatString, "Student's ID", "Student's Name", "Total Payment")
formatString = String.Replace("{2}", "{2:C}")
Class217FileReader = New StreamReader("class217.txt")
PaymentsFileReader = New StreamReader("payments.txt")
Do Until PaymentsFileReader.EndOfStream
Do Until Class217FileReader.EndOfStream
Dim aline As String = Class217FileReader.ReadLine
Dim aline1 As String = PaymentsFileReader.ReadLine
Dim fields() As String = aline.Split(","c)
Dim fields1() As String = aline1.Split(","c)
Dim StudentId As Integer = Convert.ToInt32(fields1(0))
Dim studentId1 As Integer = Convert.ToInt32(fields(0))
Dim StudentName As String = fields(1) & " " & fields(2)
Dim totalpayment As Integer = Convert.ToInt32(fields1(1)) + Convert.ToInt32(fields1(2)) + Convert.ToInt32(fields1(3))
If ShouldDisplay(StudentId, studentId1) Then
txtshowpayments.Text &= String.Format(formatString, StudentId, StudentName, totalpayment)
End If
Loop
Loop
Even better... look into a DataGrid control.

VBA How do I place HTML in an email that sends through an Access module

I have some VBA code that has been given to me that sends an email with an attachment through MS Access:
Sub Email_Send()
Dim strTo As String
Dim strCc As String
Dim strFrom As String
Dim strSubject As String
Dim strMessage As String
Dim intNrAttch As Integer
Dim strAttachments As String
Dim strAttachments2 As String
Dim Contact_Name As String
Dim EMAIL_Address As String
Dim CC_Address As String
Dim Column1 As ADODB.Recordset
Dim cnnDB As ADODB.Connection
Dim Area As String
Dim Connection As String
Dim BasePath As String
Dim Region As String
Dim Column2 As String
Dim UPC As String
Dim Name As String
Dim FirstName As String
Dim Title As String
Dim Surname As String
Dim Bold As String
Dim a As String
BasePath = "MY PATH"
Set cnnDB = New ADODB.Connection
With cnnDB
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "MY CONNECTION STRING"
.Open
End With
Set rstRst = New ADODB.Recordset
rstRst .Source = "SELECT [column1], [column2], [column3]" & _
"FROM table1"
rstRst.Open , cnnDB
rstRst.MoveFirst
Do While Not rstRst .EOF
Column1 = rstRst.Fields("Column1")
Column2 = rstRst.Fields("Column2")
Column3_Address = rstRst.Fields("Column3")
Dim Greeting As String
If Time >= #12:00:00 PM# Then
Greeting = "Afternoon,"
Else
Greeting = "Morning,"
End If
Dim CurrentMonth As String
CurrentMonth = MonthName(Month(Date))
strMessage = "Good" & Greeting & Chr(13)
strMessage = strMessage & Chr(13)
strMessage = strMessage & "...TEXT..." & Chr(13)
strMessage = strMessage & Chr(13)
strMessage = strMessage & "...TEXT..." & Chr(13)
strMessage = strMessage & "" & Chr(13)
strMessage = strMessage & "...TEXT..." & Chr(13)
strMessage = strMessage & "" & Chr(13)
strMessage = strMessage & "...TEXT..." & Chr(13)
strMessage = strMessage & "" & Chr(13)
strMessage = strMessage & "...TEXT..." & Chr(13)
strMessage = strMessage & "...TEXT..." & Chr(13)
strMessage = strMessage & Chr(13)
strMessage = strMessage & "...TEXT..." & Chr(13)
strMessage = strMessage & "...TEXT..." & Chr(13)
strTo = EMAIL_Address
'strCc = CC_Address
strSubject = "Information: ...TEXT..." & Column2 & "...TEXT..."
intNrAttch = 1
strAttachments = BasePath & Column1 & "file.xls"
Call SendMessageTo(strTo, strSubject, strMessage, intNrAttch, strAttachments)
rstRST.MoveNext
Loop
MsgBox "sent"
NowExit:
End Sub
Public Function SendMessageTo(strTo As String, strSubject As String, strMessage As String, intNrAttch As Integer, strAttachments As String) As Boolean
Const Nr = 9
Dim MyOutlook As Object
Dim MyMessage As Object
Dim objNameSpace
Dim strFiles(Nr) As String
Dim strPromt As String
Dim i As Integer, intLen As Integer
Dim intStart, intPos As Integer
On Error GoTo Error_Handler
SendMessageTo = False
Set MyOutlook = CreateObject("Outlook.Application")
Set MyMessage = MyOutlook.CreateItem(0)
If strTo = "" Then
strPromt = "You need to specify the e-mail address to wich you want to send this e-mail"
MsgBox strPromt, vbInformation, "Send Message To... ?"
Exit Function
End If
If intNrAttch > Nr + 1 Then
strPromt = "You can only add up to " & Nr + 1 & " attachments. If you want to add more you will need to change the array size"
MsgBox strPromt, vbCritical, "Number of Attachments"
End If
intStart = 1
intLen = 0
If strAttachments <> "" Then
For i = 0 To intNrAttch - 1
If i < intNrAttch - 1 Then
intLen = InStr(intStart, strAttachments, ";") - intStart + 1
strFiles(i) = Trim(Mid(strAttachments, intStart, intLen - 1))
intStart = intStart + intLen
Else
strFiles(i) = Trim(Mid(strAttachments, intStart, Len(strAttachments) - intStart + 1))
End If
Next i
End If
intPos = Len(strMessage) + 1
With MyMessage
.To = strTo
.Subject = strSubject
.Body = strMessage
strAttachments = "1"
If strAttachments <> "" Then
For i = 0 To intNrAttch - 1
.Attachments.Add strFiles(i), 1, intPos
Next i
End If
.Send
End With
Set MyMessage = Nothing
Set MyOutlook = Nothing
SendMessageTo = True
Error_Handler_Exit:
Exit Function
Error_Handler:
MsgBox Err.Number & " : " & Err.Description, vbCritical, Error
Resume Error_Handler_Exit
End Function
What I want to do is use HTML to format the strMessage = "...TEXT..." for example to put it in bold.
I have tried doing the following:
Set MyMessage = MyOutlook.CreateItem(0)
With MyMessage
.HTMLBody = .HTMLBody & "<br><B>WEEKLY REPPORT:</B><br>" _
& "<img src='cid:DashboardFile.jpg'" & "width='814' height='33'><br>" _
& "<br>Best Regards,<br>Ed</font></span>"
End With
I have looked at various websites, including: http://vba-useful.blogspot.co.uk/2014/01/send-html-email-with-embedded-images.html But I cannot get it to work.
How can I do this?
First of all, don't mix .Body and .HTMLBody. Pick one. As you want formatting & a pic, .HTMLBody is what you need.
Second: don't mix upper case and lower case HTML tags. Use lower.
Third: watch out for invalid HTML, like closing a font and a span tag that have never been opened. Also use <br /> instead of <br> (outdated).
Fourth: Set the HTMLBody entirely, do not append to it.
I don't know whether your img will display but that's step two anyway.
That being said, try this:
MyMessage.HTMLBody = "<p class=MsoNormal>" & strMessage & "<br /><b>WEEKLY REPORT:</b><br />" _
& "<img src='cid:DashboardFile.jpg' width='814' height='33' /><br />" _
& "<br />Best Regards,<br />Ed</p>"
Edit: if you wish to keep the line breaks in strMessage, just replace chr(13) with <br /> first.

Function to return info

I changed the above to use string builder but some reason its not comming through on the loop its returning ok through the OrdersLine variable but not to the stream . Below is the loop im declaring it in
Dim OrdersLine As String
For Each item As String In split
For Each thisEntry As DataRow In orderHeaderInformation.Rows
orderLineInformation = connection.SqlSelectToDataTable(scriptBuilder.GetOrderLineInformation(item, thisEntry.Item("location")))
Dim orderNumber = From row In newEntries.AsEnumerable()
Select row.Field(Of String)("ordernumber") Distinct
For Each c In IO.Path.GetInvalidFileNameChars
filename = thisEntry.Item("orderNumber").ToString().Replace(c, "")
Next
ediExportPath = configuration.EditExport
filename = ediExportPath & "\" & filename & "_" & thisEntry.Item("location") & ".edi"
Dim streamWriter As New IO.StreamWriter(filename)
OrdersLine = ExportOrdersLine(orderLineInformation).ToString()
streamWriter.WriteLine(OrdersLine)
streamWriter.Close()
streamWriter.Dispose()
Next
Next
Public Function ExportOrdersLine(editProductLine As DataTable) As String
Dim retVal As String
Dim newRecord As infoEDILine
Dim filenameWithoutExtensions As String
Dim i As Integer = 1
Dim edilIneOrder As New StringBuilder
For Each thisentry In editProductLine.Rows
edilIneOrder.AppendLine("LIN+" & i & thisentry.Item("TagBcode") & ":EN'")
edilIneOrder.AppendLine("PIA+1" & thisentry.Item("PLU") & ":SA'")
edilIneOrder.AppendLine("IMD+C++CU'")
edilIneOrder.AppendLine("IMD+F++:::" & thisentry.Item("Style.Description") & "'")
edilIneOrder.AppendLine("QTY+" & thisentry.Item("PLU") & ":1'")
edilIneOrder.AppendLine("QTY+" & thisentry.Item("OnOrder") & ":1'")
edilIneOrder.AppendLine("TAX+7+VAT+++:::00" & thisentry.item("VatRate") & "'")
' if the vat rate is zero add three zeros to above line
' if the vat rate is not zero add only two 00 lke above line
' if no decimal places add one decimal place of zero
edilIneOrder.AppendLine("MOA+203:" & thisentry.item("LineNetCost") & "'")
edilIneOrder.AppendLine("PRI++AAA:" & thisentry.Item("GrossCost") & "'")
edilIneOrder.AppendLine("PRI++AAB:" & thisentry.Item("WholeSaleCost") & "'")
edilIneOrder.AppendLine("UNS+S'")
i = i + 1
Next
Return edilIneOrder.ToString()
End Function
Turns Out I was missing
streamWriter.AutoFlush = True