Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 5 years ago.
Improve this question
Below is a code that is supposed to count number of occurrences of a given substring in a given string. I did not write it, it was taken from a web page which link I will provide later.
Function StringCountOccurrences(strText As String, strFind As String, _
Optional lngCompare As VbCompareMethod) As Long
' Counts occurrences of a particular character or characters.
' If lngCompare argument is omitted, procedure performs binary comparison.
'Testcases:
'?StringCountOccurrences("","") = 0
'?StringCountOccurrences("","a") = 0
'?StringCountOccurrences("aaa","a") = 3
'?StringCountOccurrences("aaa","b") = 0
'?StringCountOccurrences("aaa","aa") = 1
Dim lngPos As Long
Dim lngTemp As Long
Dim lngCount As Long
If Len(strText) = 0 Then Exit Function
If Len(strFind) = 0 Then Exit Function
lngPos = 1
Do
lngPos = InStr(lngPos, strText, strFind, lngCompare)
lngTemp = lngPos
If lngPos > 0 Then
lngCount = lngCount + 1
lngPos = lngPos + Len(strFind)
End If
Loop Until lngPos = 0
StringCountOccurrences = lngCount
End Function
The question is why is it giving an error message that I may have entered a comma without preceding value or identifier?
A web page the code was taken from: http://codevba.com/visual-basic-source-code/vb-string/count_occurrences_in_a_string.htm#.WlAPpzdG2Uk
Thank you.
Here is perhaps another way to write the function:
Function StringCountOccurences(strTxt As String, strFnd As String, Optional lngCmp As VbCompareMethod) As Long
If Len(strFnd) <> 0 Then
StringCountOccurences = (Len(strTxt) - Len(Replace(strTxt, strFnd, "", , , lngCmp))) / Len(strFnd)
End If
End Function
Well, reopening a database solved the problem.
Related
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 4 years ago.
Improve this question
I have some code that combines multiple word documents together, however, I would like to alter it to combine powerpoint presentations together.
I'm new to programming and struggle to find the correct sections to change or the correct 'vocab' to use.
If you could help that would be really useful.
My code is
'Code to merge selected documents together
Sub MergeDocs(strInFullNames() As String, strOutFullName As String,
intNoOfFiles As Integer)
Dim wdApp As word.Application
Dim wdDoc As Word.Document
Dim outDoc As Word.Document
Dim w As Integer
Dim bNewInstance As Boolean
'Try to use already running instance of Word
On Error Resume Next
Set wdApp = GetObject(, "word.Application")
On Error GoTo 0
If wdApp Is Nothing Then
Set wdApp = CreateObject("word.application")
bNewInstance = True
End If
Set outDoc = wdApp.Documents.Add
'For w = 0 To UBound(strInFullNames)
If w > 0 Then
' outDoc.Bookmarks("\EndOfDoc").Range.InsertBreak wdSectionBreakNextPage
' End If
' Set wdDoc = Documents.Open(strInFullNames(w))
' objSelection.PasteAndFormat
'wdDoc.Range.Copy
'wdDoc.Close wdDoNotSaveChanges
'outDoc.Bookmarks("\EndOfDoc").Range.Paste
'Next w
outDoc.SaveAs strOutFullName
'only close Word application if instance created for this macro
If bNewInstance Then
wdApp.Quit
End If
MsgBox "Word Document Created"
End Sub
Thanks
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 5 years ago.
Improve this question
I have a Db for individuals to test on courses they have taken. This Db takes input from an introduction form, selects data from a query, and passes it to the test form. This works great (with many thanks to #xpofer) in that it returns questions randomly, but the answers are always in the same order. This is because the tables and queries the Recordset is based on contains the following columns:
TABLE
ID
CDC
Vol
Question No (Randomized in query)
Section
Question
Ans A
Ans B
Ans C
Ans D
Correct Answer
What I am trying to do is not only present the questions randomly, but have the answers presented randomly also. To do so, I have separated this into two separate tables.
tblRnd_Ques
ID (PK)
CDC
Vol
Question No
Section
Question
tblRnd_Ans
ID
Q_ID (FK)
Answer
Correct (Y/N)
Here are the queries I am trying to use.
qryRnd_Ques
ID
CDC
Vol
Question No.
Section
Question
Rnd_ID (Randomized ID, ascending)
qryRnd_Ans
Rnd_ID (Randomized ID, Ascending)
Q_ID
Answer
Correct (Y/N)
Now for the problem. Is it possible to create a Recordset using a variable from a previous Recordset? Here is the code I currently have:
Private Sub GetAnswers()
Dim rsAns As Recordset
Dim strAns As String
Dim strSQL As String
Dim intQues As Long
Dim isCorr As Boolean
intQues = !ID
strSQL = "Select [ID], [Answer], [Correct] FROM [qryRnd_Ans] WHERE [Q_ID] = " & intQues
Set rsAns = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
strAns = !Answer
isCorr = !Correct
MsgBox "Answer: " & strAns _
& Chr(13) & Chr(10) & "Correct: " & isCorr
rsAns.Close
End Sub
I have tried creating this second Recordset (rsAns) directly in the LoadNextQuestion sub where I now call GetAnswers. I kept getting
Run-time error 3464: Data type mismatch in criteria expression
with this code:
strSQL = "Select [ID], [Answer], [Correct] FROM [qryRnd_Ans] WHERE [Q_ID] = '" & intQues & "'"
Set rsAns = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
I figured I may need to place this code in a subroutine, hence the call to GetAnswers. With this code, I get a Compile error: Invalid or unqualified reference at the strAns = !Answer line. I have searched many sites, including Microsoft, CNet, bytes.com, as well as Stackoverflow, and it appears as if the syntax is correct, so I am at a loss as to the problem. Any assistance is appreciated.
UPDATE
After much sole- AND Internet searching, I found a solution. I changed the variable values from strAns = !Answer to strAns = rsAns![Answer], and it all fell into place. Many thanks to DanielG and the other sites I searched.
Since it is an int, have you tried taking your single quotes out:
strSQL = "Select [ID], [Answer], [Correct] FROM [qryRnd_Ans] WHERE [Q_ID] = " & intQues
To get all of the answers in the recordset, you can now iterate the recordset:
If Not (rsANS.EOF And rsANS.BOF) Then
Do Until rsANS.EOF = True
' Get the next answer and do something with it
' Me!MyTextBox = rsANS!MyNextAnswer
rsANS.MoveNext
Loop
End If
To validate user input, I use different functions in Access VBA which all may produce error codes. The primary function creates a sum of all error codes and returns it to the requesting procedure. As error codes I used a binary sequence to create an unique return code (1,2,4,8,16,32,64,128, etc)
Can anyone help me with a simple piece of VBA code to decode the return code to see which errors occurred, for example provide all error codes in an array?
For example: error 274 is a result of 2, 16 and 256
Looked for hours, but anything I could find is written in another code like C#, Perl, etc. (which I were not able to change into VBA)
Thx!
That's a typical greedy algorithm. Something like this will help you start:
Public Sub TestMe()
Dim lngInput As Long
Dim lngTry As Long
Dim lngReduce As Long: lngReduce = 10
lngInput = 274
While lngInput > 0
lngTry = 2 ^ lngReduce
lngReduce = lngReduce - 1
If lngInput \ lngTry > 0 Then
lngInput = lngInput - lngTry
Debug.Print lngTry
End If
Wend
End Sub
You will get 256, 16, 2 printed in the console.
I use this function to determine whether a flag enum has a given flag - seems applicable to your case:
Public Function HasFlag(ByVal value As Long, ByVal flag As Long) As Boolean
HasFlag = (value And flag) = flag
End Function
It's basically a small abstraction over a little bitwise check.
That way you can define an enum with your custom error codes:
Public Enum CustomErrors
ERR_None = 0
ERR_Foo = 2 ^ 0
ERR_Bar = 2 ^ 1
ERR_Fizz = 2 ^ 2
ERR_Buzz = 2 ^ 3
ERR_Something = 2 ^ 4
ERR_SomethingElse = 2 ^ 5
ERR_AnotherThing = 2 ^ 6
ERR_SomethingWrong = 2 ^ 7
'...
End Enum
And then if you get 274 and need to know if that contains ERR_Something you can do this:
If HasFlag(Err.Number, ERR_Something) Then
' handle ERR_Something
End If
If HasFlag(Err.Number, ERR_Bar) Then
' handle ERR_Bar
End If
Or whatever rocks your boat / suits your needs. You could make a function that iterates all the possible error codes, and returns an array or collection with all the codes for which HasFlag returns True.
Note: custom error codes should be added to vbObjectError to make sure you're not shadowing/overlapping the built-in error numbers, which could be quite confusing. So, if you intend to use them with Err.Raise, I'd suggest you do Err.Raise vbObjectError + theCustomErrorCode, and subtract vbObjectError from the error code when checking its flags. That way when you get error 13 you know it's a type mismatch, not a custom-flag error.
something like this?
Option Explicit
Sub errDecode()
Dim errCode As Integer: errCode = 13
Dim errText As Variant: errText = Array("error0", "error1", "error2", "error3", "error4", "error5", "error6", "error7")
Dim i As Integer
For i = 7 To 0 Step -1
If (errCode And (2 ^ i)) > 0 Then Debug.Print errText(i),
Next i
Debug.Print
End Sub
Thx for this. Based on your example I came up with the following function that works form me. All error codes are now placed into an array AppErrCodes
Public Function AppErrCodes(lngRetCode As Long)
On Error Resume Next
Dim lngResult As Long
Dim lngReduce As Long
Dim lngTempResult() As Long
Dim i As Integer
lngReduce = 50 'increase this number when > 50 error codes are expected
While lngRetCode > 0
lngResult = 2 ^ lngReduce
lngReduce = lngReduce - 1
If lngRetCode \ lngResult > 0 Then
lngRetCode = lngRetCode - lngResult
'Debug.Print lngResult
If lngResult > 0 Then
ReDim Preserve lngTempResult(i)
lngTempResult(i) = lngResult
i = i + 1
'Debug.Print lngTempResult(i)
End If
End If
Wend
AppErrCodes = lngTempResult
End Function
Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
Closed 8 years ago.
This question appears to be off-topic because it lacks sufficient information to diagnose the problem. Describe your problem in more detail or include a minimal example in the question itself.
Questions asking for code must demonstrate a minimal understanding of the problem being solved. Include attempted solutions, why they didn't work, and the expected results. See also: Stack Overflow question checklist
Improve this question
I've found the following VBA code to generate the `sCode string.
But how do I insert sCode into Table1.
I'm new to MS Access programming.
Private Sub Command120_Click()
Dim sCode As String
Dim i As Long
For i = 1 To Me.Qty
sCode = Format(Now(), "YYMMDDHHNNSS") & Format(i, "0000")
Next i
End Sub
At least two ways - in both I'll assume the field itself is called sCode...
1) Use DAO:
Private Sub Command120_Click()
Dim RS AS DAO.Recordset, sCode As String, i As Long
Set RS = CurrentDb.OpenRecordset("Table1")
For i = 1 To Me.Qty
sCode = Format(Now(), "YYMMDDHHNNSS") & Format(i, "0000")
RS.AddNew
RS!sCode = sCode
RS.Update
Next i
End Sub
2) Use an SQL statement:
Private Sub Command120_Click()
Dim DB AS DAO.Database, sCode As String, i As Long
Set DB = CurrentDb
For i = 1 To Me.Qty
sCode = Format(Now(), "YYMMDDHHNNSS") & Format(i, "0000")
DB.Execute("INSERT INTO Table1 (sCode) VALUES ('" + sCode + "')");
Next i
End Sub
You may also want to wrap things up in a transaction if you want to be sure none rather than some of the updates will go through when there is an error.
Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
Questions asking for code must demonstrate a minimal understanding of the problem being solved. Include attempted solutions, why they didn't work, and the expected results. See also: Stack Overflow question checklist
Closed 9 years ago.
Improve this question
I am making a simple form with a button. When comCount (the button) is clicked i want my program to open a txt file and return the text in a table (tblResults) and show the count of each value from the .txt .. (animals.txt)
The input in the .txt file looks like this
Cat
Cat
Dog
Bird
Fish
Cat
Dog
And so on. Just one animal per line
I don't know how to do this, so if anyone could help me along, i would be grateful.
The tblResult should then return
Cat 3
Dog 2
Bird 1
Fish 1
Thanks!
Private Sub comCount_Click()
Dim sFileName As String
Dim sAnimal As String
Dim sQuery As String
Dim dbs As DAO.Database
Dim rsSQL As DAO.Recordset
Dim iCount As Integer
Set dbs = CurrentDb
sFileName = "C:\Animals.txt" 'Enter your full path here
Open sFileName For Input As #1
While Not EOF(1)
Line Input #1, sAnimal
sQuery = "Select * from tblResults where AnimalName = """ & sAnimal & """"
Set rsSQL = dbs.OpenRecordset(sQuery)
If rsSQL.RecordCount = 0 Then
rsSQL.AddNew
rsSQL.Fields("AnimalName") = sAnimal
rsSQL.Fields("AnimalCount") = 1
rsSQL.Update
Else
rsSQL.Edit
Count = rsSQL.Fields("AnimalCount") + 1
rsSQL.Fields("AnimalCount") = iCount
rsSQL.Update
End If
rsSQL.Close
Wend
Close #1
End Sub
Also assuming you have two fields in your table, AnimalName and AnimalCount