Easier way to use declared Strings in Query in VBA - excel

I'm writing a macro which should run queries to transfer data from excel to a Access database, and everything is working fine, however, if I want to use a String in one of these queries, I've to type them like this:
'" & Lijn & "'
I know that the following code (which is written in VBA) is way easier to write in Javascript, by using question marks and setString:
VBA:
Dim ShiftsQ As String
ShiftsQ = "INSERT INTO Shifts(Lijn, Operator, Ploeg, Teamleider) VALUES ('" & Lijn & "', '" & Operator & "', '" & Ploeg & "', '" & Teamleider & "');"
Javascript:
var ShiftsQ = SQL.prepareStatement(INSERT INTO Shifts(Lijn, Operator, Ploeg, Teamleider) VALUES (?, ?, ?, ?);
ShiftsQ.setString(1, Lijn);
ShiftsQ.setString(2, Operator);
ShiftsQ.setString(3, Ploeg);
ShiftsQ.setString(4, Teamleider);
Is there anyway to write the VBA code like the Javascript one?

As far as I know, there is nothing like the .NET string.Format() method VBA. But you could write your own version of such a function that uses deputys and returns a formatted string.
Private Sub Main()
' Your actual query
' The deputys are indexed in curley brackets (inspired from the .NET syntax of the equivalent function, making your code easy to read for .NET programmers)
Dim qry As String
qry = "SELECT {0}, {1} FROM {2} WHERE {3}"
' The values to set for the deputys in your query
Dim parameters(3) As String
parameters(0) = "firstname"
parameters(1) = "lastname"
parameters(2) = "users"
parameters(3) = "userID = 'M463'"
' For demo purposes, this will display the query in a message box
' Instead of the MsgBox, you would use the formatted query to execute against the database
MsgBox FormatString(qry, parameters)
End Sub
' This is where the magic happens, the deputys in the given string will be replaced with the actual values from the provided array
Private Function FormatString(strInput As String, paramValues() As String)
' This will be our return value
Dim strOutput As String
strOutput = strInput
' Verify that the given count of parameters matches the given count of deputys in the input string
Dim maxParamIndex As Integer
maxParamIndex = UBound(paramValues)
Dim deputyCount As Integer
For i = 1 To Len(strOutput) + 1 Step 1
If Mid(strOutput, i, 3) = "{" & deputyCount & "}" Then
deputyCount = deputyCount + 1
End If
Next
' If there is a mismatch between the count of parameters and the count of deputys, display exception message and exit the function
' Adding +1 to maxParamIndex is neccessary, as maxParamIndex refers to the maximum index (starting at 0, not 1) of the given array and deputyCount refers to the actual count of deputys (starting at 1)
If maxParamIndex + 1 <> deputyCount Then
MsgBox "Number of deputys has to match number of parameters for the given string:" & vbCrLf & strInput, vbCritical, "Exception in Function FormatString"
FormatString = ""
End If
' Iterate through the array and replace the deputys with the given values
For i = 0 To maxParamIndex Step 1
strOutput = Replace(strOutput, "{" & i & "}", paramValues(i))
Next
' return the formatted string
FormatString = strOutput
End Function
Result of example:

If I face this problem I would simply solve it on my own (althoug there might be other "standard" solutions), by defining my own simple, global function (put in in any standard code module)
Public Function S_(str as String) as String
S_ = chr(39) & str & chr(39)
End Function
ShiftsQ = "INSERT INTO Shifts(Lijn, Operator, Ploeg, Teamleider) VALUES (" & S_(Lijn) & ", " & S_(Operator) & ", " & S_(Ploeg) & ", " & S_(Teamleider) & ");"
This way, I will follow a simple and systematic rule in all my project, that is call S_(param) on any parameter of text type in my queries...

Related

Excel Macro giving circular reference error

I am new to Macros below is what I wrote to be able to do a lookup through a function. When I debug all the values seem to work well except that at the end it gives error about circular reference.
I am making a call to below like: = GetCost("abc")
Public Function GetCost(arg1 As String)
'
' GetCost Macro
'
Dim fName As String
Dim searchItem As String
Dim result As Integer
fName = Range("B4").Value
searchItem = Chr(34) & arg1 & Chr(34)
expression = "=VLOOKUP(" & searchItem & "," & fName & ", 2, FALSE)"
ActiveCell.Value = ActiveSheet.Evaluate(expression)
result = Evaluate(expression)
GetBOMCOst = result
End Function
The circular reference is because you are trying to change the value of the cell containing the function:
remove ActiveCell.Value = ...
change result= Evaluate to result =application.caller.parent.Evaluate(expression)
Also fName=Range("B4").value should use a fully qualified reference (Sheet.Range)
And this function should be made volatile otherwise it will not recalculate whenever the value in Range("B4") changes
You need to remove your active cell reference as suggested by other.
Also, its looks like, your lookup range is incorrect. Change the lookup expression as below, in case, if you have your value in A and B column.
expression = "=VLOOKUP(" & searchItem & "," & "A:B" & ", 2, FALSE)"
And, it looks like you trying to return the value to your calling function. In VBA, to return a variable, you need to assign the variable to a function name. i.e. change your last line GetBOMCOst = result to GetCost = result
Try the below updated version of the code.
Public Function GetCost(arg1 As String) ' ' GetCost Macro ' Dim fName As String Dim searchItem As String Dim result As Integer
searchItem = Chr(34) & arg1 & Chr(34)
expression = "=VLOOKUP(" & searchItem & "," & "A:B" & ", 2, FALSE)"
result = Evaluate(expression)
GetCost = result
End Function

If Statement in for loop VBA

Im tring to get my Function to skip words in my list that arent in my string but it doesnt seem to be working
Iv tried using VBA and excel native commands... however i get the same result
Public Function test(range, y)
step = y
For Each cell In range
If InStr(cell, step, vbTextCompare) <> 0 Then
step = Application.WorksheetFunction.Replace(step,Application.WorksheetFunction.Search(cell, step), Len(cell), UCase(cell))
test = step
End If
Next cell
End Function
When I try to use this Function in Excel I get #VALUE, I suspect this is because not all the values in the list are found in the string however that the reason for the if statement
first you have the variable backwards in the Instr. and you must use the firs criterion if you use the last.
Also if you are looking for complete words then you need to use " " on the search and replace.
Lastly use vba's Replace:
Public Function test(rng As range, y As String)
Dim step As String
step = y
Dim cell As range
For Each cell In rng
If InStr(1, " " & step & " ", " " & cell & " ", vbTextCompare) > 0 Then
step = Replace(" " & step & " ", " " & cell & " ", UCase(" " & cell & " "))
End If
Next cell
test = Application.Trim(step)
End Function

Excel UDF doubles value of the evaluated SUB

1. I was trying to answer VBA UDF to split string array and got an unpleasant results during computing my UDF.
Public Function mytest(src, dest)
dest.Parent.Evaluate "test(" & src.Address(False, False) & ", " & dest.Address(False, False) & ")"
mytest = "wut"
End Function
Sub test(src As Range, dest As Range)
Dim chr, rows, cols
rows = 0
cols = 0
For chr = 1 To Len(src.Value)
Select Case Mid(src.Value, chr, 1)
Case ","
rows = rows + 1
Case ";"
cols = cols + 1
rows = 0
Case Else
Cells(dest.Row + rows, dest.Column + cols).Value = Cells(dest.Row + rows, dest.Column + cols).Value & Mid(src.Value, chr, 1) '
End Select
Next chr
End Sub
Expected results:
Formula results:
Can someone explain why does it double Value of the cell?
When I debugged test using
Sub ffs()
Call test(Cells(1, 1), Cells(3, 1))
End Sub
I got expected results, so I guess the problem is not in the test Sub?..
2. Whenever I try to add more parameters to Function and Sub (for example delimiters) Function doesn't Evaluate Sub at all
Public Function CellToRange(src, dest, DelimL, DelimC)
dest.Parent.Evaluate "test(" & src.Address(False, False) & ", " & dest.Address(False, False) & ", " & DelimL & ", " & DelimC & ")"
CellToRange = "wut"
End Function
Sub CTR(src As Range, dest As Range, Delim1, Delim2)
Dim chr, rows, cols
rows = 0
cols = 0
For chr = 1 To Len(src.Value)
Select Case Mid(src.Value, chr, 1)
Case Delim1
rows = rows + 1
Case Delim2
cols = cols + 1
rows = 0
Case Else
Cells(dest.Row + rows, dest.Column + cols).Value = Cells(dest.Row + rows, dest.Column + cols).Value & Mid(src.Value, chr, 1) '
End Select
Next chr
End Sub
Please help ._. and thanks in advance.
Solution:
Thanks Billy and Charles Williams.
Change
dest.Parent.Evaluate "CTR(" & src.Address(False, False) & ", " & dest.Address(False, False) & ", " & DelimL & ", " & DelimC & ")"
To
dest.Parent.Evaluate "0+CTR(" & src.Address(False, False) & ", " & dest.Address(False, False) & ", " & DelimL & ", " & DelimC & ")"
Thanks everyone!
The problem lies with the Worksheet.Evaluate method which is being used to get round the restriction that a UDF is not allowed to modify the worksheet structure.
Consider this code
Option Explicit
Public Function dummyudf() As String
Debug.Print "Calling Evaluate method"
ActiveSheet.Evaluate "testsub()"
Debug.Print "Returning From Evaluate method"
dummyudf = "done"
End Function
Sub testsub()
Debug.Print "testsub running"
End Sub
Sub testmacro()
Dim s As String
Debug.Print "testmacro running"
s = dummyudf
End Sub
The UDF dummyudf() uses the Evaluate method to invoke the Sub called testsub(). These are analagous to mytest and test in part 1. of the OP and to CellToRange and CTR in part 2 but are stripped down to the bare minimum.
testsub() can also be invoked directly as a macro. A second macro testmacro invokes dummyudf as a function in VBA.
The following output was obtained from the Immediate Window:
As can be seen
when invoked as a macro: testsub() behaves as expected
when dummyudf() is invoked as a UDF on the worksheet (for example by adding the formula =dummyudf() to cell A1 the Evaluate method appears to call testsub() twice
when dummyudf() is invoked as a function in VBA by running testmacro() as a macro the Evaluate method appears to call testsub() twice.
The documentation here suggests that the Name argument of the Worksheet.Evaluate method should be the name of an object, so it is a bit surprising that it is possible supply the name of a Sub. That it also seems to call any such Sub twice, is even more surprising but does underline the advice given in YowE3K's answer about not using this hack in a UDF. I'd go further: don't use Worksheet.Evaluate with any Sub.
1) It evaluates once when the formula is triggered, and again when cell A3 is updated by the function (as it is one of the cells the formula is dependent on).
2a) You are calling the wrong subroutine (test instead of CTR)
2b) You need to call your second function using something like
=CellToRange(A1;A3;""",""";""";""")
or else change the line in your code calling CTR to be
dest.Parent.Evaluate "CTR(" & src.Address(False, False) & ", " & dest.Address(False, False) & ", """ & DelimL & """, """ & DelimC & """)"
3) I strongly recommend that you do not use this sort of hack to get a UDF to update cells other than the one containing the function.

Bulk insert from Excel to SQLite without TXT or CSV file

I have a problem and I hope to get some input from any of you.
Basically, I need to write a code in VBA which enables me to take a table of data from excel to sqlite.
I have managed to do it using this code:
Sub Scrivi()
Dim objConnection As Object, objRecordset As Object
Dim strDatabase As String
Set objConnection = CreateObject("ADODB.Connection")
strDatabase = "DRIVER={SQLite3 ODBC Driver};Database=" & Application.ActiveWorkbook.Path & "\TestDB.db;"
Query = "drop table FUND; create table FUND (Fund_Code, Fund_Name, End_Date, PRIMARY KEY('Fund_Code'));"
riga = 3
colonna = 1
While Not (IsNull(ActiveSheet.Cells(row, column).Value) Or IsEmpty(ActiveSheet.Cells(row, column).Value))
Query = Query & "insert into FUND values('" & Cells(row, column) & "','" & Cells(row, column + 1) & "','" & Cells(row, column + 2) & "');"
row = row + 1
Wend
objConnection.Open strDatabase
objConnection.Execute Query
objConnection.Close
End Sub
Now I would like to change the iterative part in which I say row = row + 1 with a sort of bulk insert in which the program takes the whole table instead of doing it row by row.
I do not want a creation of csv/txt file if it is possible.
Thank you very much, any input would be appreciated.
A very basic level solution can be through first building the complete query for bulk insert and then execute the query in one go.
For Example -
insert into FUND values(val1, val2);
insert into FUND values(val3, val4);
can be replaced with -
insert into FUND values(val1, val2),(val3, val4)
you could append all data from worksheet.range into array(variant)
Dim arr as Variant
arr = Application.Transpose(range(your_range_of_data).values)
and then, using data in array, build SQL query string using this pattern
INSERT INTO table
(column1, column2, ... )
VALUES
(expression1, expression2, ... ),
(expression1, expression2, ... ),
...;
VBA Function (written 'on the knee', so it might require a little bit of tweaking, sorry)
Function buildQueryFromArray(arr as Variant, table as String, columns as String) as String
Dim strSqlQuery as String * 4096
Dim i as Integer
strSqlQuery = "INSERT INTO " & table & " (" & columns & ") VALUES"
For i=LBound(arr, 1) to UBound(arr, 1)
strSqlQuery = strSqlQuery & "(" & arr(i,1) & ", " & arr(i,2) & "etc" & "),"
Next i
buildQueryFromArray = Left(strSqlQuery, len(strSqlQuery)-1) & ";"
End Function
reason for using array instead of grabbing data directly from worksheet is: its much much faster. You can read more here: http://www.cpearson.com/excel/ArraysAndRanges.aspx
lemme know if that works for you : )
EDIT:
Ad1: you're right, we actually don't want to transpose it. however, I got used to write this way because of the reasons which are well described in post #7 in this topic: mrexcel.com/forum/ Why we use application.transpose?
Ad2: no, it doesn't have to be in function if this is your question, but it makes code cleaner and more reusable. Below you can find inline solution:
Sub Scrivi()
Dim objConnection As Object, objRecordset As Object
Dim strDatabase As String, strQuery as String
Set objConnection = CreateObject("ADODB.Connection")
strDatabase = "DRIVER={SQLite3 ODBC Driver};Database=" & Application.ActiveWorkbook.Path & "\TestDB.db;"
strQuery = "drop table FUND; create table FUND (Fund_Code, Fund_Name, End_Date, PRIMARY KEY('Fund_Code')); insert into FUND values"
'determine how many rows of data there is
Dim lastRow as Integer
lastRow = ActiveSheet.Range("A:A").Find("*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'transfer all data from range to array
'range: from A3 to Cx, where x equals to lastRow
Dim arr as Variant
arr =
ActiveSheet.Range("A3:C" & lastRow).Value
'add all records from arr into single SQL query
'Lbound(xArray, xDimension)/Ubound(xArray, xDimension) - returns integer equal to first/last xArray item in xDimension. Everyday-use function. Google some more to have better insight of whats going on
Dim i as Integer
For i=Lbound(arr,1) to Ubound(arr,1)
strQuery = strQuery & "(" & arr(i,1) & "," & _
arr(i,2) & "," & _
arr(i,3) & "),"
Next i
'from the strQuery - swap last comma for semi-colon
strQuery = Left(strQuery, len(strQuery)-1) & ";"
objConnection.Open strDatabase
objConnection.Execute strQuery
objConnection.Close
Lemme know if everything is clear :)

Can I make my VBScript program ignore a field when reading from Excel?

I did a little bit of reading on what I am about to ask, but I couldn't find a specific answer.
I am writing a program in VBScript that will read an excel file and then update an Access Database.
It works great, but the problem I can foresee running into is thus:
What happens when the excel file has a blank on a specified field? I don't want the script file to update a "blank" to the database, I want it to be left unchanged in the database ONLY if there is a blank in the excel file. If not, proceed as normal.
Currently, it will read this as a blank and insert the blank into the row in my database.
Is this possible? For the script to basically ignore fields it reads (in Excel) that are blank while only updating (in the database) the fields that actually have data (in Excel) in them?
Currently, it says no in the field in the database. This is just a brief code example. In the Excel sheet, it says yes in the correct column.
Do Until objExcel.Cells(intRow,1).Value = ""
asset_Tag = objExcel.Cells(intRow, 1).Value
ebay = objExcel.Cells(intRow, 2).Value
intRow = intRow + 1
objRecordSet.Open "UPDATE Test SET Listed_Ebay = '" & ebay & "' WHERE Asset_Tag = '" & asset_Tag & "'", _
objConnection
Loop
If you are reluctant to add 20 If statements to your code, surely you could put Excel's native COUNTA functionality to make sure that there are 20 values before the update operation.
With objExcel
Do Until .Cells(intRow,1).Value = ""
If .Application.CountA(.Cells(intRow, 1).Resize(1, 20)) = 20 Then
asset_Tag = .Cells(intRow, 1).Value
ebay = .Cells(intRow, 2).Value
objRecordSet.Open "UPDATE Test SET Listed_Ebay = '" & ebay & "' WHERE Asset_Tag = '" & asset_Tag & "'", objConnection
End if
intRow = intRow + 1
Loop
End With
I had a guess a bit as to which 20 values were intended to be filled but I think you can get the idea.
EDIT NOTEĀ¹: reordered the code lines to maintain the intRow according to the loop.
EDIT NOTEĀ²: You may want to conditionally pass the original value back into the UPDATE query if the LEN of the new value is zero.
Dim qry as String
qry = "UPDATE Test SET " & _
"Listed_Ebay = Iif(CBool(Len('" & ebay & "')), '" & ebay & "', Listed_Ebay), " & _
"Listed_Amazon = Iif(CBool(Len('" & amzon& "')), '" & amzon & "', Listed_Amazon), " & _
"Listed_POS = Iif(CBool(Len('" & pos& "')), '" & pos & "', Listed_POS) " & _
"WHERE Asset_Tag = '" & asset_Tag & "'"
objRecordSet.Open qry, objConnection
I'm just making stuff up past the original one field example you provided but you should be able to transcribe this for your own 8 fields. I'm using LEN here on text values but comparing numbers to zero (or even their LEN would be appropriate.

Resources