If I click on yes, VBA keeps going to the function Mandate? What did I do wrong?
Public AutoDate As Date
Public NewDate As String
Public Sub GetDate() ' DATUM BEPALEN
AutoDate = Date - 1
MsgBox (AutoDate), (vbYesNo), ("Datum")
Dim Response As VbMsgBoxResult
If Response = vbYes Then
NewDate = AutoDate
Call DeleteDate
Else ' No
Call ManDate
End If
End Sub
You haven't assigned the result of MsgBox to Response.
Not sure if VbMsgBoxResult is a valid data type in that instance either.
Try either of these:
Public Sub GetDate() ' DATUM BEPALEN
AutoDate = Date - 1
If MsgBox(AutoDate, vbYesNo, "Data") = vbYes Then
NewDate = AutoDate
Call DeleteDate
Else ' No
Call ManDate
End If
End Sub
or
Public Sub GetDate() ' DATUM BEPALEN
Dim Response As Long
AutoDate = Date - 1
Response = MsgBox(AutoDate, vbYesNo, "Data")
If Response = vbYes Then
NewDate = AutoDate
Call DeleteDate
Else ' No
Call ManDate
End If
End Sub
You need retrieve the Response as the return of the MsgBox function:
Dim Response as Integer
Response= MsgBox( AutoDate, vbYesNo, "Datum")
Now you can if-test Response to decide what to do.
You need a variable to capture the response ...
Dim ans As Integer
ans = MsgBox("hello", vbYesNo, "Datum")
If ans = vbYes Then
MsgBox "Yes"
Else
MsgBox "No"
End If
Related
I am trying to create a function to test if a textbox is null. I am trying to accomplish this because I have a lot to my code and I figured this would be a great way to clean up my code making it easier to read.
Main Code Page
Private Sub Command0_Click()
Dim textbox1 As String
textbox1 = Forms![Form1].Text1
MsgBox CheckTextbox(textbox1)
End Sub
Function
Public Function CheckTextbox(textboxA As String)
If IsNull(textboxA) Then
CheckTextbox = "Yes"
Else
CheckTextbox = textboxA
End If
End Function
A String can not be Null, thus:
Private Sub Command0_Click()
Dim textbox1 As Variant
textbox1 = Forms![Form1].Text1.Value
MsgBox CheckTextbox(textbox1)
End Sub
and:
Public Function CheckTextbox(textboxA As Variant)
If IsNull(textboxA) Then
CheckTextbox = "Yes"
Else
CheckTextbox = textboxA
End If
' or simply:
CheckTextbox = Nz(textboxA, "Yes")
End Function
I have a BackGroundWorker that fetches data in mySQL to be viewed inside a DataGridView. In my DoWork Event
connection()
Try
conn.Open()
Dim query As String
query = "SELECT column02 AS 'Company ID', column05 AS Lastname,
column06 AS Firstname, column07 AS Middlename,
column04 AS 'Contact No.', column13 AS 'Area'
FROM table01
WHERE column10 = '" & selectedAccount & "'
AND column18 = 'Yes'"
command = New MySqlCommand(query, conn)
dataAdapter.SelectCommand = command
dataAdapter.Fill(dataTable)
bSource.DataSource = dataTable
DataGridView_Accounts.DataSource = bSource
For i As Integer = 0 To dataTable.Rows.Count - 1
dataTable.Rows(i)("Company ID") = dataTable.Rows(i)("Company ID")
dataTable.Rows(i)("Lastname") = dataTable.Rows(i)("Lastname")
dataTable.Rows(i)("Firstname") = dataTable.Rows(i)("Firstname")
dataTable.Rows(i)("Middlename") = dataTable.Rows(i)("Middlename")
dataTable.Rows(i)("Contact No.") = dataTable.Rows(i)("Contact No.")
dataTable.Rows(i)("Area") = dataTable.Rows(i)("Area")
Next
conn.Close()
Catch ex As Exception
MessageBox.Show(ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Finally
conn.Dispose()
End Try
It is throwing me errors in my DataGridView about Cross-Threading.
I have tried to move this to the RunWorkerCompleted event
DataGridView_Accounts.DataSource = bSource
For i As Integer = 0 To dataTable.Rows.Count - 1
dataTable.Rows(i)("Company ID") = dataTable.Rows(i)("Company ID")
dataTable.Rows(i)("Lastname") = dataTable.Rows(i)("Lastname")
dataTable.Rows(i)("Firstname") = dataTable.Rows(i)("Firstname")
dataTable.Rows(i)("Middlename") = dataTable.Rows(i)("Middlename")
dataTable.Rows(i)("Contact No.") = dataTable.Rows(i)("Contact No.")
dataTable.Rows(i)("Area") = dataTable.Rows(i)("Area")
Next
There are no more errors about Cross-Threading, but I can't view the result in my DataGridView. It is empty even if my database is filled. Thanks
See if this gets you closer to working...
Imports MySql.Data
Public Class Form1
Private Const ConnectionString As String = ""
' This probably comes from the form but OP did not share that with us.
Private selectedAccount As String = ""
Private dataTable As New DataTable
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Task.Run(Sub() DoWork())
End Sub
Private Sub DoWork()
Dim query As String = "SELECT column02 AS 'CompanyID', column05 AS Lastname,
column06 AS Firstname, column07 AS Middlename,
column04 AS 'ContactNo', column13 AS 'Area'
FROM table01 WHERE column10 = #selectedAccount AND column18 = 'Yes'"
Using MySqlConnection As New MySqlClient.MySqlConnection(ConnectionString)
Dim MySqlCommand As New MySqlClient.MySqlCommand(query, MySqlConnection)
' Use Parameters to avoid vulnerability to SQL Injection
MySqlCommand.Parameters.Add("#selectedAccount", MySqlClient.MySqlDbType.String)
MySqlCommand.Parameters("#selectedAccount").Value = selectedAccount
Using MySqlDataAdapter As New MySqlClient.MySqlDataAdapter(MySqlCommand)
MySqlDataAdapter.Fill(dataTable)
End Using
End Using
RefreshGrid()
End Sub
Sub RefreshGrid()
If Me.InvokeRequired Then
' Shift this call to the UI thread
Me.Invoke(Sub() RefreshGrid())
Else
bSource.DataSource = dataTable
DataGridView_Accounts.DataSource = bSource
DataGridView_Accounts.Refresh()
End If
End Sub
End Class
Honestly, "pretty names" should be set in the DGV, not the SQL, but that's for another topic and I didn't chase this solution that far.
I need to filter where clause in my GetProduct function using http request query string property. I have set up my filters in urls. (eg burgers.aspx?filter=burgers'). Burgers is the name of database table category(Where ProductCat = filter). I understand I need to pass parameter to interaction class because it does not handle requests. Please help.
Interaction class:
Public Class Interaction
Inherits System.Web.UI.Page
' New instance of the Sql command object
Private cmdSelect As New SqlCommand
' Instance of the Connection class
Private conIn As New Connection
Region "Menu functions and subs"
' Set up the SQL statement for finding a Product by ProductCat
Private Sub GetProduct(ByVal CatIn As String)
' SQL String
Dim strSelect As String
strSelect = "SELECT * "
strSelect &= " FROM Menu "
strSelect &= " WHERE ProductCat = "
strSelect &= "ORDER BY 'ProductCat'"
' Set up the connection to the datebase
cmdSelect.Connection = conIn.Connect
' Add the SQL string to the connection
cmdSelect.CommandText = strSelect
' Add the parameters to the connection
cmdSelect.Parameters.Add("filter", SqlDbType.NVarChar).Value = CatIn
End Sub
'Function to create list of rows and columns
Public Function ReadProduct(ByVal CatIn As String) As List(Of Dictionary(Of String, Object))
'Declare variable to hold list
Dim ReturnProducts As New List(Of Dictionary(Of String, Object))
Try
Call GetProduct(CatIn)
Dim dbr As SqlDataReader
' Execute the created SQL command from GetProduct and set to the SqlDataReader object
dbr = cmdSelect.ExecuteReader
'Get number of columns in current row
Dim FieldCount = dbr.FieldCount()
Dim ColumnList As New List(Of String)
'Loop through all columns and add to list
For i As Integer = 0 To FieldCount - 1
ColumnList.Add(dbr.GetName(i))
Next
While dbr.Read()
'Declare variable to hold list
Dim ReturnProduct As New Dictionary(Of String, Object)
'Loop through all rows and add to list
For i As Integer = 0 To FieldCount - 1
ReturnProduct.Add(ColumnList(i), dbr.GetValue(i).ToString())
Next
'Add to final list
ReturnProducts.Add(ReturnProduct)
End While
cmdSelect.Parameters.Clear()
'Close connection
dbr.Close()
Catch ex As SqlException
Dim strOut As String
strOut = ex.Message
Console.WriteLine(strOut)
End Try
' Return the Product object
Return ReturnProducts
End Function
Code Behind:
Partial Class Burger
Inherits System.Web.UI.Page
'String Used to build the necessary markup and product information
Dim str As String = ""
''Var used to interact with SQL database
Dim db As New Interaction
' New instance of the Sql command object
Private cmdSelect As New SqlCommand
' Instance of the Connection class
Private conIn As New Connection
Protected Sub printMenuBlock(ByVal productName As String)
'Set up variable storing the product and pull from databse
Dim product = db.ReadProduct(productName)
'Add necessary markup to str variable, with products information within
For i As Integer = 0 To product.Count - 1
str += "<div class='menuItem'>"
'str += " <img alt='Item Picture' class='itemPicture' src='" + product(i).ImagePath.Substring(3).Replace("\", "/") + "' />"
str += " <div class='itemInfo'>"
str += " <h1 class='itemName'>"
str += " " + product(i).Item("ProductName") + "</h1>"
'str += " <h3 class='itemDescription'>"
str += " " + product(i).Item("ProductDescription")
str += " <h1 class ='itemPrice'>"
str += " " + product(i).Item("ProductPrice") + "</h1>"
str += " "
str += " </div>"
str += " </div>"
Next
End Sub
''Uses
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
'Dim v = Request.QueryString("filter")
'Response.Write("filter is")
'Response.Write(v)
Dim value = Request.QueryString("filter")
'Get string from printMenuBlock method
printMenuBlock(str)
'Print the str variable in menuPlace div
menuPlace.InnerHtml = str
End Sub
End Class
I need a direction on how to pass the Request.QueryString("filter") to GetProduct function to filter by page according to ProductCategory. Thanks in advance.
Try something like this:
Dim filter = Request.QueryString("filter")
Dim sqlStr = "Select * From menu Where ProductCat = #filter Order By ProductCat"
cmdSelect.Parameters.Add("filter", SqlDbType.NVarChar).Value = filter
I've completely rewritten this old asmx service function but I still can't get it to return JSON. It returns XML, even if I use ajax() and set the datatype and contenttype to json. I'm trying to use this function with Jquery dataTables. And I know there are tons of questions like this but all of them I've found are C# and I was unable to adapt them.
up-to-date pastebin of full asmx file: http://pastebin.com/swXKqgd4
new code
<WebMethod()> _
<WebGet(ResponseFormat:=WebMessageFormat.Json)> _
Public Function rptPendingServerRequests() As Generic.List(Of request)
Dim _conn As SqlConnection = New SqlConnection(connectionString)
Dim _dr As SqlDataReader
Dim Sql As String = String.Empty
Sql += "<My query here>"
Try
Dim _cmd As SqlCommand = New SqlCommand(Sql, _conn)
_conn.Open()
_dr = _cmd.ExecuteReader(CommandBehavior.CloseConnection)
If _dr.HasRows Then
Dim s As request
Dim c As New Generic.List(Of request)
While _dr.Read
s = New request
With s
.requestID = _dr("request_id")
.status = _dr("status")
.requester = _dr("req_by_user_id")
.assignee = _dr("user_id")
.nextAction = _dr("description")
End With
c.Add(s)
End While
Return c
End If
Catch ex As Exception
MsgBox(ex.Message)
Finally
_conn.Close()
End Try
End Function
New class
<Serializable()> _
Public Class request
Private _requestID As Integer
Public Property requestID() As Integer
Get
Return _requestID
End Get
Set(ByVal value As Integer)
_requestID = value
End Set
End Property
Private _requester As String
Public Property requester() As String
Get
Return _requester
End Get
Set(ByVal value As String)
_requester = value
End Set
End Property
Private _requestDate As Date
Public Property requestDate() As Date
Get
Return _requestDate
End Get
Set(ByVal value As Date)
_requestDate = value
End Set
End Property
Private _status As Integer
Public Property status() As Integer
Get
Return _status
End Get
Set(ByVal value As Integer)
_status = value
End Set
End Property
Private _assignee As String
Public Property assignee() As String
Get
Return _assignee
End Get
Set(ByVal value As String)
_assignee = value
End Set
End Property
Private _nextAction As String
Public Property nextAction() As String
Get
Return _nextAction
End Get
Set(ByVal value As String)
_nextAction = value
End Set
End Property
End Class
Original Code
<WebMethod()> _
<WebGet(ResponseFormat:=WebMessageFormat.Json)> _
Public Function rptPendingServerRequestsOld() As DataSet
Dim connection As SqlConnection
Dim command As SqlCommand
Dim adapter As New SqlDataAdapter
Dim ds As New DataSet
Dim sql As String
sql = ""
sql += "<MY query here>"
connection = New SqlConnection(connectionString)
Try
connection.Open()
command = New SqlCommand(sql, connection)
adapter.SelectCommand = command
adapter.Fill(ds)
adapter.Dispose()
command.Dispose()
connection.Close()
Return ds
Catch ex As Exception
End Try
End Function
Client
$('#report').dataTable({
"bProcessing": true,
"sAjaxSource": 'reportdata.asmx/rptPendingServerRequests'
});
Since you're calling this method from JS instead of
<WebGet(ResponseFormat:=WebMessageFormat.Json)>
use
<ScriptMethod(ResponseFormat:=ResponseFormat.Json)>
attribute. Also don't forget to mark your WebService class with
<ScriptService()>
attribute.
Change this line.
Public Function rptPendingServerRequests() As Generic.List(Of request)
to
Public Function rptPendingServerRequests() As String.
I want to create a table for LEDs. This table creates information such as name, center wavelength and the spectrum, which itself is data in the format intensity over wavelenth as 2 x n table data.
I am a beginner in access and have currently no clue how to insert this to a table.
I could of course create for each LED a table on its own, but there will be hundreds of these spectrum datas.
Such a complex data structure may be difficult to implement in a database table. An option I propose is to have a set of classes that represent the data. Then you can serialize and deserialize (read and write) the data to a file.
Sample Implementation
Module Module1
Sub Main()
Dim leds = New List(Of LED)()
Dim rnd = New Random()
'create a bunch of LEDs
For i = 1 To 10
Dim led = New LED("LED " & (i + 1).ToString(), rnd.Next(0, i * 100))
For x = 1 To 10
led.Spectrum.Add(New SpectrumInfo(rnd.Next(1, 10), rnd.Next(1000, 10000)))
Next
leds.Add(led)
Next
' write the led data to a file
Using sw As New IO.StreamWriter("LED Data.ledx")
Dim xs = New System.Xml.Serialization.XmlSerializer(leds.GetType())
xs.Serialize(sw, leds)
End Using
'read the led data from a file
Dim leds2 = New List(Of LED)()
Using sr = New System.IO.StreamReader("LED Data.ledx")
Dim xs = New System.Xml.Serialization.XmlSerializer(leds2.GetType())
leds2 = DirectCast(xs.Deserialize(sr), List(Of LED))
End Using
'confirm the two are the same
Console.WriteLine("LEDs and LEDS2 are " & If(leds.SequenceEqual(leds2), "the same", "different"))
' alternate saving using binary serializer
' works in cases where XmlSerializer doesn't
' produces smaller files too
'save the led data
Using fs = New System.IO.FileStream("LED Data.ledb", IO.FileMode.Create)
Dim bf = New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter()
bf.Serialize(fs, leds)
End Using
'read the led data
Dim leds3 = New List(Of LED)()
Using fs = New System.IO.FileStream("LED Data.ledb", IO.FileMode.Open)
Dim bf = New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter()
leds3 = DirectCast(bf.Deserialize(fs), List(Of LED))
End Using
'confirm equality
Console.WriteLine("LEDs and LEDS3 are " & If(leds.SequenceEqual(leds3), "the same", "different"))
Console.WriteLine("LEDs2 and LEDS3 are " & If(leds2.SequenceEqual(leds3), "the same", "different"))
Console.ReadLine()
End Sub
End Module
<Serializable()> _
Public Class LED
Dim _name As String
Dim _cWL As Double
Dim _spectrum As List(Of SpectrumInfo)
Public Sub New()
_name = String.Empty
_cWL = 0
_spectrum = New List(Of SpectrumInfo)()
End Sub
Public Sub New(name As String, cwl As Double, ParamArray spectrum() As SpectrumInfo)
_name = name
_cWL = cwl
_spectrum = New List(Of SpectrumInfo)(spectrum)
End Sub
Public Property Name As String
Get
Return _name
End Get
Set(value As String)
_name = value
End Set
End Property
Public Property CenterWavelength As Double
Get
Return _cWL
End Get
Set(value As Double)
_cWL = value
End Set
End Property
Public ReadOnly Property Spectrum As List(Of SpectrumInfo)
Get
Return _spectrum
End Get
End Property
Public Overrides Function Equals(obj As Object) As Boolean
If Not (TypeOf obj Is LED) Then Return False
Dim l2 = DirectCast(obj, LED)
Return l2._name = _name AndAlso l2._cWL = _cWL AndAlso l2._spectrum.SequenceEqual(_spectrum)
End Function
Public Overrides Function ToString() As String
Return String.Format("{0} [{1}]", _name, _cWL)
End Function
Public Overrides Function GetHashCode() As Integer
Dim result As Integer
For Each spec In _spectrum
result = result Xor spec.GetHashCode()
Next
Return result Xor (_name.GetHashCode() + _cWL.GetHashCode())
End Function
End Class
<Serializable()> _
Public Structure SpectrumInfo
Dim _intensity As Double
Dim _wavelength As Double
Public Sub New(intensity As Double, wavelength As Double)
_intensity = intensity
_wavelength = wavelength
End Sub
Public ReadOnly Property Intensity As Double
Get
Return _intensity
End Get
End Property
Public ReadOnly Property Wavelength As Double
Get
Return _wavelength
End Get
End Property
Public Overrides Function Equals(obj As Object) As Boolean
If TypeOf obj Is SpectrumInfo Then
Dim si = DirectCast(obj, SpectrumInfo)
Return si._wavelength = _wavelength AndAlso si._intensity = _intensity
Else
Return False
End If
End Function
Public Overrides Function ToString() As String
Return String.Format("Intensity: {0}, Wavelength: {1}", _intensity, _wavelength)
End Function
Public Overrides Function GetHashCode() As Integer
Return _intensity.GetHashCode() Xor _wavelength.GetHashCode()
End Function
End Structure
You might look at http://r937.com/relational.html
I think you want:
LED Table
ID
LEDName
CenterWavelength
And then a table for spectra
ID
LedId
Intensisty
WaveLength