I'm trying to iterate through two listboxes and adding all the items to one list.
Here's my code so far but I can't seem to integrate the second listbox into it.
Dim List As List(Of String) = New List(Of String)
For Each LB1 As String In Listbox1.Items
List.Add(vbTab + vbTab + "ent = maps\mp\_utility::createOneshotEffect(" + """" + LB1.ToString() + """" + ");" + vbCrLf +
vbTab + vbTab + "ent.v[ " + """" + "origin" + """" + " ] = ( " + LB2.ToString() + " );"
Next
As long as LB1 and LB2 both contain the same number of items and both are ordered the same, you could use an indexed loop (instead of a foreach loop):
Dim List As List(Of String) = New List(Of String)
For x as integer = 0 to Listbox1.Items.count - 1
List.Add(vbTab + vbTab + "ent = maps\mp\_utility::createOneshotEffect(""" + _
ListBox1.Items(x).ToString() + """);" + vbCrLf + _
vbTab + vbTab + "ent.v[ ""origin"" ] = ( " + _
ListBox2.Items(x).ToString() + " );" _
)
Next
Related
I've got a dynamic textbox filtering function in VBA
Dim sSQL As String
sSQL = "SELECT qry_allUtilities.ID, qry_allUtilities.Supplier AS Lieferant, qry_allUtilities.Cabinet AS Ablageort, qry_allUtilities.Size AS Grösse, qry_allUtilities.WorkingLength AS Nutzlänge, qry_allUtilities.Description AS Bezeichnung "
sSQL = sSQL & " FROM qry_allUtilities "
If Not sFilter = "" Then
Dim arrFilter
arrFilter = Split(sFilter, "+")
Dim varWort
For Each varWort In arrFilter
If Not varWort = "" Then
Dim sWort As String
sWort = varWort
sSQL = sSQL & " AND [ID] & ' ' & [Supplier] & ' ' & [Floor] & ' ' & [Cabinet] & ' ' & [Size] & ' ' & [WorkingLength] LIKE '*" & sWort & "*'"
End If
Next
sSQL = Replace(sSQL, " AND ", " WHERE ", 1, 1, vbTextCompare)
End If
ctlListe.RowSource = sSQL
and would like to extend this with another WHERE clause because I have to exclude the records with qry_allUtilities.InActive=False
How do I do this? I always keep getting null or it won't exclude the records with InActive=True :/
I usually do this to add a variable (but unknown) number of filter options:
strFilter = "" ' build the filter string in here
if <first condition reason is true> then
strFilter = strFilter + first condition + " AND "
end if
if <second condition reason is true> then
strFilter = strFilter + <second condition> + " AND "
end if
' finish up
if len(strFilter) > 0 then ' some critera are valid
strFilter = Left(strFilter, Len(strFilter) - 5) ' chop off the spare " AND "
strFilter = " WHERE " + strFilter ' put the " WHERE " on the front
' else ' no where clause
end if
Note that the spaces either side of the " AND " and " WHERE " are important.
Im trying to send json object in Outlook using vba. Here is my code:
Dim Msg As Outlook.MeetingItem
Set Msg = Item
Set recips = Msg.Recipients
Dim regEx As New RegExp
regEx.Pattern = "^\w+\s\w+,\sI351$"
Dim URL As String
URL = "https://webhook.site/55759d1a-7892-4c20-8d15-3b8b7f1bf3b3"
For Each recip In recips
If regEx.Test(recip.AddressEntry) And recip.AddressEntry <> "Application Management Linux1, I351" Then
Dim convertedJson As Object
Set convertedJson = JsonConverter.ParseJson("{""fields"": 123}")
Set xhr = CreateObject("MSXML2.ServerXMLHTTP.6.0")
xhr.Open "POST", URL, False
xhr.setRequestHeader "Content-Type", "application/json"
xhr.Send (convertedJson)
End If
Next
If I send just plane text it works well but i can't send convertedJson. Is it possible to send an object?
UPDATE
I can't even do Debug.Print convertedJson
I was tormented by these libraries in the end I did a very terrible thing
Dim flds, prt, id, smry, descrp, issu, name, lfbrkt, rtbrkt, cma, dbdots, jsTest, issuName As String
flds = "'fields'"
prt = "'project'"
id = "'id'"
smry = "'summary'"
descrp = "'description'"
issu = "'issuetype'"
issuName = "'Improvement'"
name = "'name'"
lfbrkt = "{"
rtbrkt = "}"
cma = ","
dbdots = ":"
jsTest = lfbrkt + flds + dbdots + " " + lfbrkt + vbCrLf + vbTab + prt + dbdots + " " + lfbrkt + vbCrLf + vbTab + vbTab + id + dbdots + " " + "30611" + vbCrLf + vbTab + rtbrkt + cma + vbCrLf + vbTab + smry + dbdots + " " + "'" + CStr(Msg.Subject) + "'" + cma + vbCrLf + vbTab + descrp + dbdots + " " + "'" + CStr(Msg.Body) + "'" + cma + vbCrLf + vbTab + issu + dbdots + " " + lfbrkt + vbCrLf + vbTab + vbTab + name + dbdots + " " + issuName + vbCrLf + vbTab + rtbrkt + vbCrLf + rtbrkt + rtbrkt
And I got this
please help me. this is a uni project and I keep getting the error "Conversion from string "" to type 'Double' is not valid." even when I made sure that everything is in the correct type, everything with a value...etc.
I want to insert some new rows in my access database, here is a picture of the table that Im trying to insert into
enter image description here
and this is the code
the error appears at the select statement in the sub w()
Dim c As Integer
Dim b As Double
Dim a, d, z As String
a = "'" + TextBox1.Text + "'"
b = CInt(TextBox2.Text)
c = CInt(TextBox3.Text)
d = "'" + TextBox4.Text + "'"
z = "'" + ComboBox1.SelectedItem + "'"
If ComboBox1.SelectedItem = "الجبيل" Then
w("insert into employees (em_id,em_name,m_id,city,phone,salary,password)" & " values (" + 32111 + "," + a + "," + 12303 + "," + z + "," + c + "," + b + "," + d + ")")
ElseIf ComboBox1.SelectedItem = "جدة" Then
w("insert into employees (em_id,em_name,m_id,city,phone,salary,password)" & " values (" + 32111 + "," + a + "," + 12302 + "," + z + "," + c + "," + b + "," + d + ")")
ElseIf ComboBox1.SelectedItem = "الرياض" Then
w("insert into employees (em_id, em_name,m_id,city,phone,salary,password)" & " values (" + 32111 + "," + a + "," + 12301 + "," + z + "," + c + "," + b + "," + d + ")")
End If
MsgBox("تم إضافة السجل بنجاح")
TextBox1.Clear()
TextBox2.Clear()
TextBox3.Clear()
TextBox4.Clear()
the sub w("") is:
Public Sub w(ByVal s As String)
Dim cum As New OleDbCommand(s, con)
cum.ExecuteNonQuery()
End Sub
problem is that it works on different forms (to diffident tables and stuff), but not in here...
what should I do?
I do not get any syntax errors in the code below, but when I compile the code I get the Msgbox("cant post status") instead of the output from main.p(x).status(0). The x and 0 can be any number and I always get the cant post status box. What bugs me most is that I have a debug form with a richtextbox that I load all the data from all seven occurrences of the array: p into when the program starts, and it works just fine. I've included that code as well at the very bottom. Before I run the logging sub, I run an initialization sub that puts a default value into every variable. When I don't have the try/catch in the main_loop, I do not get an error, but all execution stops. My computer doesn't freeze, but actions that should take place after that sub do not. Does anyone know why I can't make a call to main.p(x).status(0) inside this sub?
'Main Class'
Public p(6) as structs.player
Public Shared Sub main_loop()
For x As Integer = 0 To (Main.p.Count - 1) Step 1
If Main.check_act(x) = False Then
MsgBox("past check act")
If Main.p(x).pos >= 1 And Main.p(x).pos <= 3 Then
MsgBox("past pos; pre death")
Try
MsgBox(Main.p(x).status(0))
Catch ex As Exception
MsgBox("cant post status")
End
End Try
End If
End If
Next
End Sub
'Structs Class'
Public Structure player
Dim name As String
Dim type As String
Dim pos As Integer
Dim wait As Integer
Dim mhp As Integer
Dim chp As Integer
Dim mmp As Integer
Dim cmp As Integer
Dim map As Integer
Dim cap As Integer
Dim atk As Integer
Dim def As Integer
Dim mak As Integer
Dim mdf As Integer
Dim spd As Integer
Dim acc As Integer
Dim eva As Integer
Dim crt As Integer
Dim status() As Integer
Dim stats() As Integer
Dim statr() As Integer
Dim elems() As Integer
Dim elemr() As Integer
Dim abl() As Boolean
End Structure
'Debug Class'
Public Shared Sub log(p As player)
'Stats'
Debug.log.Text += ">>> " & p.name.ToString & " <<<" & Chr(10)
Debug.log.Text += "Type: " & p.type.ToString & Chr(10)
Debug.log.Text += "Pos: " & p.pos.ToString & Chr(10)
Debug.log.Text += "Wait: " & p.wait.ToString & Chr(10) & Chr(10)
Debug.log.Text += "HP: " & p.mhp.ToString & _
"/" & p.chp.ToString & Chr(10)
Debug.log.Text += "MP: " & p.mmp.ToString & _
"/" & p.cmp.ToString & Chr(10)
Debug.log.Text += "AP: " & p.map.ToString & _
"/" & p.cap.ToString & Chr(10) & Chr(10)
Debug.log.Text += "ATK: " & p.atk.ToString & Chr(10)
Debug.log.Text += "DEF: " & p.def.ToString & Chr(10)
Debug.log.Text += "MAK: " & p.mak.ToString & Chr(10)
Debug.log.Text += "MDF: " & p.mdf.ToString & Chr(10)
Debug.log.Text += "SPD: " & p.spd.ToString & Chr(10)
Debug.log.Text += "ACC: " & p.acc.ToString & Chr(10)
Debug.log.Text += "EVA: " & p.eva.ToString & Chr(10)
Debug.log.Text += "CRT: " & p.crt.ToString & Chr(10) & Chr(10)
'Status And Elements'
For x As Integer = 0 To (p.status.Count - 1) Step 1
Debug.log.Text += p.status(x).ToString & Chr(10)
Next
Debug.log.Text += Chr(10)
For x As Integer = 0 To (p.stats.Count - 1) Step 1
Debug.log.Text += p.stats(x).ToString & Chr(10)
Next
Debug.log.Text += Chr(10)
For x As Integer = 0 To (p.statr.Count - 1) Step 1
Debug.log.Text += p.statr(x).ToString & Chr(10)
Next
Debug.log.Text += Chr(10)
For x As Integer = 0 To (p.elems.Count - 1) Step 1
Debug.log.Text += p.elems(x).ToString & Chr(10)
Next
Debug.log.Text += Chr(10)
For x As Integer = 0 To (p.elemr.Count - 1) Step 1
Debug.log.Text += p.elemr(x).ToString & Chr(10)
Next
Debug.log.Text += Chr(10)
'Abilities'
For x As Integer = 0 To (p.abl.Count - 1) Step 1
Debug.log.Text += p.abl(x).ToString & Chr(10)
Next
Debug.log.Text += Chr(10)
End Sub
I quickly debugged the code an determined that status(0) is the issue.
The following screen image shows the error ...
please help me...
I load my database in the datagrid view and edit some cells.
Now I just need to update my database
here are my codes
Dim dT As DataTable = MyDB.ExecCommand("SELECT `Field Name` FROM `tblfield`", "wellsfargo").Tables(0)
Dim sSQL As String = ""
Dim dZ As DataTable = MyDB.ExecCommand("SELECT " & sColumn & " FROM `" + cboJob.Text.Trim + "`", "wellsfargo", 0).Tables(0)
dColumn = New DataTable
dColumn = MyDB.ExecCommand("SHOW COLUMNS IN tblrecord", "wellsfargo", 0).Tables(0)
If dZ.Rows.Count <> 0 Then
sSQL = "UPDATE " & sColumn & " FROM `" + cboJob.Text.Trim + "`"
MyDB.ExecQuery(sSQL, "wellsfargo")
Else
Dim sColumn As String = ""
For z As Integer = 0 To dT.Rows.Count - 1
If z = 0 Then
sColumn = "`" & dT.Rows(z).Item(0).ToString & "`"
Else
sColumn = sColumn & ",`" & dT.Rows(z).Item(0).ToString & "`"
End If
Next
sSQL = "INSERT INTO `" + MyJob + "` (" + sColumn + ") "
MyDB.ExecQuery(sSQL, "wellsfargo")
End If
Done.
I used this codes..
Try
Cursor = Cursors.WaitCursor
Dim sSQL As String
sSQL = "UPDATE `" + cboJob.Text.Trim + "` SET `Description` ='" + TextBox1.Text + "' WHERE `Description`= '" + Label2.Text + "' AND `Line Number` ='" + comList.Text + "'"
MyDB.ExecQuery(sSQL, "wellsfargo")
MsgBox("Updated!")
btnUpdate.Enabled = False
Catch ex As Exception
MsgBox("Select table first to Update")
End Try
Cursor = Cursors.Default