It seems that there are already some answers available but I can't find proper answer for my question.
Here is the code:
Private Sub Combo2_click()
Dim item_id, price As Integer
Dim item_name As String
If Combo2.Index Is 0 Then
price = 30
ElseIf Combo2.Index Is 1 Then
price = 40
ElseIf Combo2.Index Is 2 Then
price = 50
ElseIf Combo2.Index Is 3 Then
price = 60
Else
price = 55
End If
End Sub
I am getting error as "Compile Error : Type MisMatch" ... I don't know why! It is showing error on the like Private Sub COmbo2_click() ...
There are two mistakes in your code:
1- You should use Combo2.ListIndex instead of .Index. (because index is used for something else and that's when your control is an element in an array)
2- You should replace Is with = (and that's what throws the exception of Type mismatch).
Hope that helps :)
Related
I'm trying to add records to an exisiting table called "Topics" (section as of "For Each SelectedTopic In SelectedTopicsCtl.ItemsSelected" in the code below).
When executing the code i always get "Run-time error '3022': The changes you requested to the table were not successful because they would create duplicate values in the index, primary key, or relationship. So it goes wrong at the creation of the Autonumber in the field "ID" (= the only field that is indexed - no duplicates).
When debugging, line "TopicRecord.Update" in the code below is highlighted.
I have read several posts on this topic on this forum and on other forums but still cannot get this to work - i must be overlooking something....
Private Sub Copy_Click()
Dim JournalEntrySourceRecord, JournalEntryDestinationRecord, TopicRecord As Recordset
Dim JournalEntryToCopyFromCtl, JournalEntryToCopyToCtl, JournalEntryDateCreatedCtl, SelectedTopicsCtl As Control
Dim Counter, intI As Integer
Dim SelectedTopic, varItm As Variant
Set JournalEntryToCopyFromCtl = Forms![Copy Journal Entry]!JournalEntryToCopyFrom
Set JournalEntryToCopyToCtl = Forms![Copy Journal Entry]!JournalEntryToCopyTo
Set JournalEntryDateCreatedCtl = Forms![Copy Journal Entry]!JournalEntryDateCreated
Set JournalEntrySourceRecord = CurrentDb.OpenRecordset("Select * from JournalEntries where ID=" & JournalEntryToCopyFromCtl.Value)
Set JournalEntryDestinationRecord = CurrentDb.OpenRecordset("Select * from JournalEntries where ID=" & JournalEntryToCopyToCtl.Value)
Set SelectedTopicsCtl = Forms![Copy Journal Entry]!TopicsToCopy
Set TopicRecord = CurrentDb.OpenRecordset("Topics", dbOpenDynaset, dbSeeChanges)
With JournalEntryDestinationRecord
.Edit
.Fields("InitiativeID") = JournalEntrySourceRecord.Fields("InitiativeID")
.Fields("DateCreated") = JournalEntryDateCreatedCtl.Value
.Fields("Comment") = JournalEntrySourceRecord.Fields("Comment")
.Fields("Active") = "True"
.Fields("InternalOnly") = JournalEntrySourceRecord.Fields("InternalOnly")
.Fields("Confidential") = JournalEntrySourceRecord.Fields("Confidential")
.Update
.Close
End With
JournalEntrySourceRecord.Close
Set JournalEntrySourceRecord = Nothing
Set JournalEntryDestinationRecord = Nothing
For Each SelectedTopic In SelectedTopicsCtl.ItemsSelected
TopicRecord.AddNew
For Counter = 3 To SelectedTopicsCtl.ColumnCount - 1
TopicRecord.Fields(Counter) = SelectedTopicsCtl.Column(Counter, SelectedTopic)
Next Counter
TopicRecord.Fields("JournalEntryID") = JournalEntryToCopyToCtl.Value
TopicRecord.Fields("DateCreated") = JournalEntryDateCreatedCtl.Value
TopicRecord.Update
Next SelectedTopic
TopicRecord.Close
Set TopicRecord = Nothing
End Sub
First, your Dims won't work as you expect. Use:
Dim JournalEntrySourceRecord As Recordset
Dim JournalEntryDestinationRecord As Recordset
Dim TopicRecord As Recordset
Second, it looks like you get your ID included here:
TopicRecord.Fields(Counter)
or Topic is a query that includes it somehow. Try to specify the fields specifically and/or debug like this:
For Counter = 3 To SelectedTopicsCtl.ColumnCount - 1
TopicRecord.Fields(Counter).Value = SelectedTopicsCtl.Column(Counter, SelectedTopic)
Debug.Print Counter, TopicRecord.Fields(Counter).Name
Next Counter
I'm studying computing at AS Level in England, and the language we are using is VB6.
I am working on out assignment which has to be completed for 18/12/2014.
The project is for a hypothetical situation where a running club needs software to do the following:
- Add Members
- View Members
- Edit Member Information
- Search for Members
- Delete Members
- Add Training Information for Members
- View Training Information
- Compare Training Information
- Automatically select a team of runners based upon the number of hours trained for
Here's my code for the problem form:
Option Explicit
Private Sub CmdExitFromSelectTeam_Click()
Unload Me
End Sub
Private Sub SelectTeam()
Dim TrainingChannel As Integer
Dim Training As TrainingRecord
Dim MemberChannel As Integer
Dim Member As MemberRecord
Dim MemberRecordPointer As Integer
Dim TotalHoursTrained As Single
Dim TrainingRecordPointer As Integer
Dim FoundAtLeastOneRecord
FoundAtLeastOneRecord = False
MemberChannel = FreeFile
Open MemberFile For Random As MemberChannel Len = MemberLength
MemberRecordPointer = 1
Get MemberChannel, MemberRecordPointer, Member
Do While Not EOF(MemberChannel)
TotalHoursTrained = 0
TrainingRecordPointer = 1
TrainingChannel = FreeFile
Open TrainingFile For Random As TrainingChannel Len = TrainingLength
Get TrainingChannel, MemberRecordPointer, Training
Do While Not EOF(TrainingChannel)
If Member.ID = Training.MemberID Then
TotalHoursTrained = Round(TotalHoursTrained, 1) + Round(Training.TimeTaken, 1)
End If
TrainingRecordPointer = TrainingRecordPointer + 1 (*)
Get TrainingChannel, MemberRecordPointer, Training
Loop
Close TrainingChannel
LstTeamSelectDisplayTeam.AddItem TotalHoursTrained, 1
LstTeamSelectDisplayTeam.AddItem Member.ID, 2
LstTeamSelectDisplayTeam.AddItem Member.Forename, 3
LstTeamSelectDisplayTeam.AddItem Member.Surname, 4
MemberRecordPointer = MemberRecordPointer + 1
Get MemberChannel, MemberRecordPointer, Member
Loop
Close MemberChannel
End Sub
Private Sub Form_Load()
SelectTeam
End Sub
When this form (FrmSelectTeam.frm) is loaded at run time, the line: marked with (*) is highlighted as the debug line.
I have no idea what the problem is, and I'd appreciate all the help I can get, so thanks in advance!!!
James
In VB6, the maximum value for the Integer data type is 32767. You are apparently exceeding that limit in the (*) statement. You can change it to a 32-bit integer by declaring it long:
Dim TrainingRecordPointer As Long
#xpda's answer is almost certainly correct.
One handy debugging trick for an error like this, is to modify your code slightly, as below:
Open MemberFile For Random As MemberChannel Len = MemberLength
MemberRecordPointer = 1
Get MemberChannel, MemberRecordPointer, Member
Do While Not EOF(MemberChannel)
TotalHoursTrained = 0
TrainingRecordPointer = 1
TrainingChannel = FreeFile
Open TrainingFile For Random As TrainingChannel Len = TrainingLength
Get TrainingChannel, MemberRecordPointer, Training
Do While Not EOF(TrainingChannel)
If Member.ID = Training.MemberID Then
TotalHoursTrained = Round(TotalHoursTrained, 1) + Round(Training.TimeTaken, 1)
End If
If TrainingRecordPointer > 32750 Then
Debug.Print TrainingRecordPointer
End If
TrainingRecordPointer = TrainingRecordPointer + 1
Get TrainingChannel, MemberRecordPointer, Training
Loop
Close TrainingChannel
LstTeamSelectDisplayTeam.AddItem TotalHoursTrained, 1
LstTeamSelectDisplayTeam.AddItem Member.ID, 2
LstTeamSelectDisplayTeam.AddItem Member.Forename, 3
LstTeamSelectDisplayTeam.AddItem Member.Surname, 4
MemberRecordPointer = MemberRecordPointer + 1
Get MemberChannel, MemberRecordPointer, Member
Loop
Close MemberChannel
Alternatively, you can put a breakpoint in the added If-Then, and step through using the debugger.
Well thankyou for your feedback, but what was actually the cause (Believe it or not) was simple human error; I put "Get TrainingChannel, MemberRecordPointer, Training" instead of "Get TrainingChannel, TrainingRecordPointer, Training"
It's so annoying that something as simple as that could cause such a big problem.
But once again, thanks!!
I have been a longtime lurker of stackoverflow and have now decided to join. I am trying to pull a list of every Functional Location out of SAP using BAPI. When I run this code it returns with an empty table. I dont have very much experiance with BAPI and I am trying to teach myself. Can someone please help with what im missing to make this work.
Thanks,
See code bellow:
Dim sapFunc As New SAPFunctionsOCX.SAPFunctions
Dim objServer = sapFunc.Connection
objServer.Client = "101"
objServer.User = "MyUserName"
objServer.Ticket = "MyKey"
objServer.system = "PEC"
objServer.MessageServer = "MyMessagerServer"
objServer.GroupName = "PUBLIC"
If objServer.logon(0, True) <> True Then
MsgBox("Key Rejected")
Exit Sub
End If
Dim objRfcFunc As SAPFunctionsOCX.Function
objRfcFunc = sapFunc.Add("BAPI_FUNCLOC_GETLIST")
'System.Console.Write(objRfcFunc.Description)
If objRfcFunc.Call = False Then
MsgBox("Error occured - " & objRfcFunc.Exception)
Exit Sub
End If
Dim tab = objRfcFunc.Tables("FUNCLOC_LIST")
System.Console.WriteLine("Input start:")
For I = 1 To tab.RowCount
For j = 1 To tab.ColumnCount
System.Console.Write(tab.ColumnName(j) + ":")
System.Console.WriteLine(tab.Cell(I, j))
Next
Next
System.Console.WriteLine("Input end.")
I don't intend for this to be an answer, but if it helps then that's good. If it doesn't, I'll delete it.
With objRfcFunc.tables("funcloc_ra")
If .RowCount < 1 Then .Rows.Add
.cell(1, 1) = "I"
.cell(1, 2) = "EQ"
.cell(1, 3) = "Your Func Loc"
End With
Do this after setting objRfcFunc and before calling it. The call will use these parameters.
I means to Include, EQ means you want to find items equal to the value in low.
I am experiencing difficulty with the following VBS code. It works only sometimes, and even then it fails quickly. Why?
Dim Butt
Set Butt = CreateObject("InternetExplorer.application")
Butt.visible = True
Butt2 = InputBox("Put the link to one hat you would like to snipe.", "Hat Selection")
Butt3 = InputBox("Enter the maximum amount of Robux you will spend on this hat.", "Maximum Payment")
Dim Proace
Set Proace = CreateObject("Microsoft.XMLHTTP")
Proace.Open "GET", "http://www.roblox.com", False
Proace.Send
Do
Do While Butt.Busy
WScript.sleep 200
Loop
St00f = CInt(Replace(Mid(St00f, (InStr(St00f, ">R$")+3), 8), "</b>", ""))
If St00f <= CInt(Butt3) Then
Butt.Navigate "javascript:WebForm_DoPostBackWithOptions(new%20WebForm_PostBackOptions(""ctl00$cphRoblox$TabbedInfo$UserSalesTab$lstItemsForResale$ctrl0$lnkBuyNow"",%20"""",%20true,%20"""",%20"""",%20false,%20true))"
Exit Do
End If
Loop
Do While Butt.Busy
WScript.sleep 200
Loop
MsgBox("Congratulations! Your snipe was successful! You sniped "&Butt2&" for "&Butt3&" Robux!")
Butt.Quit
Set Butt = Nothing
Set Proace = Nothing
WScript.Quit
Error:
Script: C:\Users\John\Downloads\SingleHatSniper.vbs
Line: 14
Char: 1
Error: Type mismatch: 'CInt'
Code: 800A000D
Source: Microsoft VBScript runtime error
Please help me, I'm not that great with VBS. That much is clear, my friend helped me write this.
As you might have known by now, this is where the error occurs
St00f = CInt(Replace(Mid(St00f, (InStr(St00f, ">R$")+3), 8), "</b>", ""))
And that line does these things
InStr that returns the numeric position of the first occurrence of ">R$"
Its then added with 3 to get the index after the string"R$"
Now Mid splits the string St00f with start index after "R$" to a length of 8
Then Replace takes the split string and replaces an occurrence of "</b>" with ""
At last CInt converts the string to an integer or more correctly * converts any number to the variant of subtype Integer*
And you are getting the error at the CInt conversion.
If I were at your place, I will split this line by line by keeping only one function per line and then try something like MsgBox for the output after each line and find what's wrong with that.
The key is the variable St00f and what that variable holds.
Happy Coding :)
The "Type mismatch" error indicates that your Replace(...) did not return a valid numerical string:
>> i = CInt("4711")
>>
>> i = CInt("999999999999")
>>
Error Number: 6
Error Description: Overflow
>> i = CInt("no number")
>>
Error Number: 13
Error Description: Type mismatch
>> i = CInt("")
>>
Error Number: 13
Error Description: Type mismatch
Consider using IsNumeric() before you apply CInt().
CInt can handle betweeen -32,768 and 32,767
Use CLng instead of CInt
Copied from Cint overflow error when value exceeds 100,000+
I am very new with programming and I have come across an issue in Visual Basic that I cannot figure out. Many forums and YouTube videos later I still do not have an answer.
I am using a nested selection structure and within it is two Message boxes. I cannot figure out how to get the second dialog result to trigger the elseif statement. It just skips over it. I believe since I have one variable declared for a dialog result it is checking both of them, but in this case I don't know how to declare only the second dialog result.
Here is the code so far.
Dim dblTotal As Double = 12
Dim strResponse As DialogResult
' Dialog box asking about a coupon and $2 coupon.
If MessageBox.Show("Does customer have a coupon?", "Coupon", MessageBoxButtons.YesNo) = vbYes AndAlso
MessageBox.Show("Does customer have a $2 coupon?", "Coupon", MessageBoxButtons.YesNo) = vbNo Then
lblTotal.Text = Convert.ToString(dblTotal - 4)
' Meant to be ran if statement is false. I dont Understand
' why it is skipping over and not executing.
' Is "dlgResult" reading the first one as well? How do I correct?
ElseIf strResponse = vbYes Then
lblTotal.Text = Convert.ToString(dblTotal - 2)
Else
lblTotal.Text = Convert.ToString(dblTotal)
End If
End Sub
I understand it would be easier to to code if the first message = vbNo, but I was trying to see if this way would work.
Thank you!!
Is this how you wanted it?
Dim dialog1 As DialogResult
Dim dialog2 As DialogResult
Dim dblTotal As Double = 12
dialog1 = MessageBox.Show("Does customer have a coupon?", "Coupon", MessageBoxButtons.YesNo)
dialog2 = MessageBox.Show("Does customer have a $2 coupon?", "Coupon", MessageBoxButtons.YesNo)
If dialog1 = DialogResult.OK Then
dblTotal = dblTotal - 2
End If
If dialog2 = DialogResult.OK Then
dblTotal = dblTotal - 2
End If
lblTotal.Text = Convert.ToString(dblTotal - 2)