VBA (Access 2016) UPDATE Query - ms-access

I've run into a problem with using a variable in a SQL Update Query in Access 2016. I have a logic field that will get updated based on a previously defined logic.
In this example, Package_Status is a Yes/No logic field in TableName.
This works:
strSQL ="UPDATE TableName SET [Package_Status] = TRUE"
dbName.Execute strSQL
This does NOT work:
xlogic = True
strSQL = "UPDATE TableName SET [Package_Status] = '" & xlogic & "'"
dbName.Execute strSQL
I'm sure the reason is obvious but I'm stumped! Why doesn't the second example work?

The way out of such misery is to print out what you build:
xlogic = True
strSQL = "UPDATE TableName SET [Package_Status] = '" & xlogic & "'"
Debug.Print strSQL
That will reveal why:
UPDATE TableName SET [Package_Status] = 'True'
Alternatively, when concatenating SQL, you can use my CSql function:
' Converts a value of any type to its string representation.
' The function can be concatenated into an SQL expression as is
' without any delimiters or leading/trailing white-space.
'
' Examples:
' SQL = "Select * From TableTest Where [Amount]>" & CSql(12.5) & "And [DueDate]<" & CSql(Date) & ""
' SQL -> Select * From TableTest Where [Amount]> 12.5 And [DueDate]< #2016/01/30 00:00:00#
'
' SQL = "Insert Into TableTest ( [Street] ) Values (" & CSql(" ") & ")"
' SQL -> Insert Into TableTest ( [Street] ) Values ( Null )
'
' Trims text variables for leading/trailing Space and secures single quotes.
' Replaces zero length strings with Null.
' Formats date/time variables as safe string expressions.
' Uses Str to format decimal values to string expressions.
' Returns Null for values that cannot be expressed with a string expression.
'
' 2016-01-30. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function CSql( _
ByVal Value As Variant) _
As String
Const vbLongLong As Integer = 20
Const SqlNull As String = " Null"
Dim Sql As String
Dim LongLong As Integer
#If Win32 Then
LongLong = vbLongLong
#End If
#If Win64 Then
LongLong = VBA.vbLongLong
#End If
Select Case VarType(Value)
Case vbEmpty ' 0 Empty (uninitialized).
Sql = SqlNull
Case vbNull ' 1 Null (no valid data).
Sql = SqlNull
Case vbInteger ' 2 Integer.
Sql = Str(Value)
Case vbLong ' 3 Long integer.
Sql = Str(Value)
Case vbSingle ' 4 Single-precision floating-point number.
Sql = Str(Value)
Case vbDouble ' 5 Double-precision floating-point number.
Sql = Str(Value)
Case vbCurrency ' 6 Currency.
Sql = Str(Value)
Case vbDate ' 7 Date.
Sql = Format(Value, " \#yyyy\/mm\/dd hh\:nn\:ss\#")
Case vbString ' 8 String.
Sql = Replace(Trim(Value), "'", "''")
If Sql = "" Then
Sql = SqlNull
Else
Sql = " '" & Sql & "'"
End If
Case vbObject ' 9 Object.
Sql = SqlNull
Case vbError ' 10 Error.
Sql = SqlNull
Case vbBoolean ' 11 Boolean.
Sql = Str(Abs(Value))
Case vbVariant ' 12 Variant (used only with arrays of variants).
Sql = SqlNull
Case vbDataObject ' 13 A data access object.
Sql = SqlNull
Case vbDecimal ' 14 Decimal.
Sql = Str(Value)
Case vbByte ' 17 Byte.
Sql = Str(Value)
Case LongLong ' 20 LongLong integer (Valid on 64-bit platforms only).
Sql = Str(Value)
Case vbUserDefinedType ' 36 Variants that contain user-defined types.
Sql = SqlNull
Case vbArray ' 8192 Array.
Sql = SqlNull
Case Else ' Should not happen.
Sql = SqlNull
End Select
CSql = Sql & " "
End Function

Related

Access cannot close after 100s of function calls - Recordset sees to be "open" although closed

I need to calculate roughly 100 medians in an access database and have a function (see code below)
After calling this many times with the code
Nz(DMedian("Price", "Qry91_Cad_by", "[Cad ID]='" & rst![Cad ID] & "'"), 0)
I cannot quit Access any more and need to kill it with the task manager (as there are open connections)
When compacting the database, I get the error "You attemted to open a database that is already open by user 'Admin' .....
You can close the database but Access itself needs to be killed
Any Ideas what's wrong?
...
Public Function DMedian( _
ByVal strField As String, ByVal strDomain As String, _
Optional ByVal strCriteria As String) As Variant
' Purpose:
' To calculate the median value
' for a field in a table or query.
' In:
' strField: the field.
' strDomain: the table or query.
' strCriteria: an optional WHERE clause to
' apply to the table or query.
' Out:
' Return value: the median, if successful;
' Otherwise, an Error value.
Dim db As DAO.Database
Dim rstDomain As DAO.Recordset
Dim strSQL As String
Dim varMedian As Variant
Dim intFieldType As Integer
Dim intRecords As Integer
Const errAppTypeError = 3169
'On Error GoTo HandleErr
Set db = CurrentDb()
' Initialize return value.
varMedian = Null
' Build SQL string for recordset.
strSQL = "SELECT " & strField & " FROM " & strDomain
' Only use a WHERE clause if one is passed in.
If Len(strCriteria) > 0 Then
strSQL = strSQL & " WHERE " & strCriteria
End If
strSQL = strSQL & " ORDER BY " & strField
Set rstDomain = db.OpenRecordset(strSQL, dbOpenSnapshot)
' Check the data type of the median field.
intFieldType = rstDomain.Fields(strField).Type
Select Case intFieldType
Case dbByte, dbInteger, dbLong, _
dbCurrency, dbSingle, dbDouble, dbDate
' Numeric field.
If Not rstDomain.EOF Then
rstDomain.MoveLast
intRecords = rstDomain.RecordCount
' Start from the first record.
rstDomain.MoveFirst
If (intRecords Mod 2) = 0 Then
' Even number of records.
' No middle record, so move to the
' record right before the middle.
rstDomain.Move ((intRecords \ 2) - 1)
varMedian = rstDomain.Fields(strField)
' Now move to the next record, the
' one right after the middle.
rstDomain.MoveNext
' And average the two values.
varMedian = _
(varMedian + rstDomain.Fields(strField)) / 2
' Make sure you return a date, even when
' averaging two dates.
If intFieldType = dbDate And Not IsNull(varMedian) Then
varMedian = CDate(varMedian)
End If
Else
' Odd number or records.
' Move to the middle record and return its value.
rstDomain.Move ((intRecords \ 2))
varMedian = rstDomain.Fields(strField)
End If
Else
' No records; return Null.
varMedian = Null
End If
Case Else
' Non-numeric field; so raise an app error.
Err.Raise errAppTypeError
End Select
DMedian = varMedian
ExitHere:
'On Error Resume Next
rstDomain.Close
Set rstDomain = Nothing
db.Close
Set db = Nothing
Exit Function
HandleErr:
' Return an error value.
DMedian = CVErr(Err.Number)
Resume ExitHere
End Function
...

Syntax error in insert into statement - what's the error?

this is the full code here for a button to add data to 2 different tables the weird thing is that i have another form wih a button wih similar function and it works fine wih the same statment
Option Compare Database
Private Sub addbutton_Click()
CurrentDb.Execute "INSERT INTO Clients(F_Name,L_Name,Phone_Number,E-mail,Gender,Date_of_Birth) " & "VALUES(" & Me.textfname & ",'" & Me.textlname & "','" & Me.textpnumber & "','" & Me.textemail & "','" & Me.textgender & "','-" & Me.textdob & "')"
CurrentDb.Execute "INSERT INTO Accounts(F_Name,L_Name,Username,Password,accounttype) " & "VALUES(" & Me.textfname & ",'" & Me.textlname & "','" & Me.textusername & "','" & Me.textpassword & "','" & Me.textaccountype & "')"
clientssubform.Form.Requery
End Sub
First, Password is a reserved word, so use [Password].
Second, a date expression must be wrapped in octothorpes: #2017/04/24#
Also, if you won't use parameters, even though recommended, use a function like this to concatenate your values:
' Converts a value of any type to its string representation.
' The function can be concatenated into an SQL expression as is
' without any delimiters or leading/trailing white-space.
'
' Examples:
' SQL = "Select * From TableTest Where [Amount]>" & CSql(12.5) & "And [DueDate]<" & CSql(Date) & ""
' SQL -> Select * From TableTest Where [Amount]> 12.5 And [DueDate]< #2016/01/30 00:00:00#
'
' SQL = "Insert Into TableTest ( [Street] ) Values (" & CSql(" ") & ")"
' SQL -> Insert Into TableTest ( [Street] ) Values ( Null )
'
' Trims text variables for leading/trailing Space and secures single quotes.
' Replaces zero length strings with Null.
' Formats date/time variables as safe string expressions.
' Uses Str to format decimal values to string expressions.
' Returns Null for values that cannot be expressed with a string expression.
'
' 2016-01-30. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function CSql( _
ByVal Value As Variant) _
As String
Const vbLongLong As Integer = 20
Const SqlNull As String = " Null"
Dim Sql As String
Dim LongLong As Integer
#If Win32 Then
LongLong = vbLongLong
#End If
#If Win64 Then
LongLong = VBA.vbLongLong
#End If
Select Case VarType(Value)
Case vbEmpty ' 0 Empty (uninitialized).
Sql = SqlNull
Case vbNull ' 1 Null (no valid data).
Sql = SqlNull
Case vbInteger ' 2 Integer.
Sql = Str(Value)
Case vbLong ' 3 Long integer.
Sql = Str(Value)
Case vbSingle ' 4 Single-precision floating-point number.
Sql = Str(Value)
Case vbDouble ' 5 Double-precision floating-point number.
Sql = Str(Value)
Case vbCurrency ' 6 Currency.
Sql = Str(Value)
Case vbDate ' 7 Date.
Sql = Format(Value, " \#yyyy\/mm\/dd hh\:nn\:ss\#")
Case vbString ' 8 String.
Sql = Replace(Trim(Value), "'", "''")
If Sql = "" Then
Sql = SqlNull
Else
Sql = " '" & Sql & "'"
End If
Case vbObject ' 9 Object.
Sql = SqlNull
Case vbError ' 10 Error.
Sql = SqlNull
Case vbBoolean ' 11 Boolean.
Sql = Str(Abs(Value))
Case vbVariant ' 12 Variant (used only with arrays of variants).
Sql = SqlNull
Case vbDataObject ' 13 A data access object.
Sql = SqlNull
Case vbDecimal ' 14 Decimal.
Sql = Str(Value)
Case vbByte ' 17 Byte.
Sql = Str(Value)
Case LongLong ' 20 LongLong integer (Valid on 64-bit platforms only).
Sql = Str(Value)
Case vbUserDefinedType ' 36 Variants that contain user-defined types.
Sql = SqlNull
Case vbArray ' 8192 Array.
Sql = SqlNull
Case Else ' Should not happen.
Sql = SqlNull
End Select
CSql = Sql & " "
End Function
Study the in-line comments for usage.
Try to change this part of code
"VALUES(" & Me.textfname & ",'" &
to this
"VALUES('" & Me.textfname & "','" &
in both lines

Filtering Access report with multiple strings in vba, getting data type mismatch

I've been teaching myself Access for the past few weeks and have done well using old questions to solve a lot of the programming conundrums I encountered. I have finally hit a wall and cannot make this filter work correctly.
I'm attempting to use multiple comboboxes on a form to filter a report by a number of criteria. It works great when filtering by customer, branch, and date range, but my numerous attempts at getting G/P% range filter added in have been very frustrating.
I'm using vba to concatenate strings coming from the comboboxes to turn them into a filter, but I either get a data type mismatch error or syntax error with the G/P range function. The underlying queries have [G/P%] formatted as a percent, the comboboxes' source are value lists ("0%","5%","10%",etc.), and I was certain to leave out the single quotes to designate the values as numbers and not strings. I've been at it for many hours trying variations on this code and nothing will work. The individual strings seem okay, but combining them into a single filter to use to open the report is where I think the issue is.
I've tried using Format() to make the values percentages; I've tried setting the variables as strings, integers, and long; I've tried moving all the text down to the final string so the G/P variables are only numbers; at this point I'm convinced that the error I've made is something small and easy that I've overlooked, but I am out of ideas.
The truly frustrating thing is I have a similar code on a different part of the form that only filters with customer name and max G/P and it works perfectly!
Public Sub cmdSalesOVFilter_Click()
Dim strBRFilter As String
Dim strCRFilter As String
Dim strFDateField As String
Dim strTDateField As String
Dim strMinGPFilter As String
Dim strMaxGPFilter As String
Dim strSOFilter As String
If IsNull(Me.cboBranchSales.Value) Then
strBRFilter = " AND [BranchName] Like '*'"
Else
strBRFilter = " AND [BranchName] ='" & Me.cboBranchSales.Value & "'"
End If
If IsNull(Me.cboCustSalesOV.Value) Then
strCRFilter = " AND [CustName] Like '*'"
Else
strCRFilter = " AND [CustName] ='" & Me.cboCustSalesOV.Value & "'"
End If
If IsNull(Me.cboSalesOVDateFrom.Value) Then
strFDateField = " AND [OrderDate]>#" & Format("6/1/2016", "Short Date") & "#"
Else
strFDateField = " AND [OrderDate]>=#" & CDate(Me.cboSalesOVDateFrom.Value) & "#"
End If
If IsNull(Me.cboSalesOVDateTo.Value) Then
strTDateField = " AND [OrderDate]<#" & Format("1/1/2505", "Short Date") & "#"
Else
strTDateField = " AND [OrderDate]<=#" & CDate(Me.cboSalesOVDateTo.Value) & "#"
End If
If IsNull(Me.cboSalesOVMinGP.Value) Then
strMinGPFilter = " AND [G/P%]>=-100"
Else
strMinGPFilter = " AND [G/P%]>=" & Me.cboSalesOVMinGP.Value
End If
If IsNull(Me.cboSalesOVMaxGP.Value) Then
strMaxGPFilter = " AND [G/P%]<=100"
Else
strMaxGPFilter = " AND [G/P%]<=" & Me.cboSalesOVMaxGP.Value
End If
strSOFilter = Mid(strCRFilter & strBRFilter & strFDateField & strTDateField & strMinGPFilter & strMaxGPFilter, 6)
Call ReportFilter(strSOFilter)
DoCmd.OpenReport "rptYTDCustInvoices", acViewReport, strSOFilter
With Reports![rptYTDCustInvoices]
.Filter = strSOFilter
.FilterOn = True
End With
End Sub
The format used in the query is of no importance, so 5% will have the value 0.05.
However, a combobox always returns strings, so 5% selected returns "5%".
This you can convert to a number:
TrueValue = Val("5%") / 100
Now, this must be properly concatenated with your SQL, and the only safe method is to use Str:
TrueTextValue = Str(Val("5%") / 100)
Forget this for a moment, because your other conversion are more or less loose:
This should read:
" And [OrderDate] >= #" & Format(CDate(Me.cboSalesOVDateFrom.Value), "yyyy\/mm\/dd") & "#"
A fixed date should either be literal:
" And [OrderDate] > #6/1/2016#" or " And [OrderDate] > #2016/6/1#"
or use DateSerial:
" And [OrderDate] >= #" & Format(DateSerial( 2016, 6, 1), "yyyy\/mm\/dd") & "#"
For the general formatting of value for concatenating, you can take advantage of my CSql function. The in-line comments list typical usage:
' Converts a value of any type to its string representation.
' The function can be concatenated into an SQL expression as is
' without any delimiters or leading/trailing white-space.
'
' Examples:
' SQL = "Select * From TableTest Where [Amount]>" & CSql(12.5) & "And [DueDate]<" & CSql(Date) & ""
' SQL -> Select * From TableTest Where [Amount]> 12.5 And [DueDate]< #2016/01/30 00:00:00#
'
' SQL = "Insert Into TableTest ( [Street] ) Values (" & CSql(" ") & ")"
' SQL -> Insert Into TableTest ( [Street] ) Values ( Null )
'
' Trims text variables for leading/trailing Space and secures single quotes.
' Replaces zero length strings with Null.
' Formats date/time variables as safe string expressions.
' Uses Str to format decimal values to string expressions.
' Returns Null for values that cannot be expressed with a string expression.
'
' 2016-01-30. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function CSql( _
ByVal Value As Variant) _
As String
Const vbLongLong As Integer = 20
Const SqlNull As String = " Null"
Dim Sql As String
Dim LongLong As Integer
#If Win32 Then
LongLong = vbLongLong
#End If
#If Win64 Then
LongLong = VBA.vbLongLong
#End If
Select Case VarType(Value)
Case vbEmpty ' 0 Empty (uninitialized).
Sql = SqlNull
Case vbNull ' 1 Null (no valid data).
Sql = SqlNull
Case vbInteger ' 2 Integer.
Sql = Str(Value)
Case vbLong ' 3 Long integer.
Sql = Str(Value)
Case vbSingle ' 4 Single-precision floating-point number.
Sql = Str(Value)
Case vbDouble ' 5 Double-precision floating-point number.
Sql = Str(Value)
Case vbCurrency ' 6 Currency.
Sql = Str(Value)
Case vbDate ' 7 Date.
Sql = Format(Value, " \#yyyy\/mm\/dd hh\:nn\:ss\#")
Case vbString ' 8 String.
Sql = Replace(Trim(Value), "'", "''")
If Sql = "" Then
Sql = SqlNull
Else
Sql = " '" & Sql & "'"
End If
Case vbObject ' 9 Object.
Sql = SqlNull
Case vbError ' 10 Error.
Sql = SqlNull
Case vbBoolean ' 11 Boolean.
Sql = Str(Abs(Value))
Case vbVariant ' 12 Variant (used only with arrays of variants).
Sql = SqlNull
Case vbDataObject ' 13 A data access object.
Sql = SqlNull
Case vbDecimal ' 14 Decimal.
Sql = Str(Value)
Case vbByte ' 17 Byte.
Sql = Str(Value)
Case LongLong ' 20 LongLong integer (Valid on 64-bit platforms only).
Sql = Str(Value)
Case vbUserDefinedType ' 36 Variants that contain user-defined types.
Sql = SqlNull
Case vbArray ' 8192 Array.
Sql = SqlNull
Case Else ' Should not happen.
Sql = SqlNull
End Select
CSql = Sql & " "
End Function

replace apostrophe with null in VBA Access

I'm trying to update a field in an Access table that replaces apostrophes with null.
Dim strLimitRecordTable As String: strLimitRecordTable = Me.txtLimitRecordTable
DoCmd.RunSQL "UPDATE " & strLimitRecordTable & " SET vCompanyMapped = replace(vCompanyMapped, ''', '') WHERE vCompanyMapped like '*'*';"
But I get this error:
Syntax error in expression replace(vCompanyMapped, ''', '') WHERE
vCompanyMapped like ''';"
I have a feeling it has to do with replacing ''' with and empty string ''
What am I doing wrong here?
I have another query that works fine:
DoCmd.RunSQL "UPDATE [" & strLimitRecordTable & "] SET Domain = Mid([Email],InStr([Email],'#')+1,Len([Email])-InStr([Email],'#')) WHERE Email Like '*#*.*';"
I would use the ascii character for finding an apostrophe in this case I would recommend you try:
Dim strLimitRecordTable As String: strLimitRecordTable =
Me.txtLimitRecordTable DoCmd.RunSQL "UPDATE " & strLimitRecordTable & " SET
vCompanyMapped = replace(vCompanyMapped, chr(39),'')
WHERE vCompanyMapped like '*'*';"
Often when I programmatically have to search for punctuation I find that it helps to use Ascii indicators. It helps cause fewer errors.
You can use this function to avoid this and most other troubles when concatenating SQL:
' Converts a value of any type to its string representation.
' The function can be concatenated into an SQL expression as is
' without any delimiters or leading/trailing white-space.
'
' Examples:
' SQL = "Select * From TableTest Where [Amount]>" & CSql(12.5) & "And [DueDate]<" & CSql(Date) & ""
' SQL -> Select * From TableTest Where [Amount]> 12.5 And [DueDate]< #2016/01/30 00:00:00#
'
' SQL = "Insert Into TableTest ( [Street] ) Values (" & CSql(" ") & ")"
' SQL -> Insert Into TableTest ( [Street] ) Values ( Null )
'
' Trims text variables for leading/trailing Space and secures single quotes.
' Replaces zero length strings with Null.
' Formats date/time variables as safe string expressions.
' Uses Str to format decimal values to string expressions.
' Returns Null for values that cannot be expressed with a string expression.
'
' 2016-01-30. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function CSql( _
ByVal Value As Variant) _
As String
Const vbLongLong As Integer = 20
Const SqlNull As String = " Null"
Dim Sql As String
Dim LongLong As Integer
#If Win32 Then
LongLong = vbLongLong
#End If
#If Win64 Then
LongLong = VBA.vbLongLong
#End If
Select Case VarType(Value)
Case vbEmpty ' 0 Empty (uninitialized).
Sql = SqlNull
Case vbNull ' 1 Null (no valid data).
Sql = SqlNull
Case vbInteger ' 2 Integer.
Sql = Str(Value)
Case vbLong ' 3 Long integer.
Sql = Str(Value)
Case vbSingle ' 4 Single-precision floating-point number.
Sql = Str(Value)
Case vbDouble ' 5 Double-precision floating-point number.
Sql = Str(Value)
Case vbCurrency ' 6 Currency.
Sql = Str(Value)
Case vbDate ' 7 Date.
Sql = Format(Value, " \#yyyy\/mm\/dd hh\:nn\:ss\#")
Case vbString ' 8 String.
Sql = Replace(Trim(Value), "'", "''")
If Sql = "" Then
Sql = SqlNull
Else
Sql = " '" & Sql & "'"
End If
Case vbObject ' 9 Object.
Sql = SqlNull
Case vbError ' 10 Error.
Sql = SqlNull
Case vbBoolean ' 11 Boolean.
Sql = Str(Abs(Value))
Case vbVariant ' 12 Variant (used only with arrays of variants).
Sql = SqlNull
Case vbDataObject ' 13 A data access object.
Sql = SqlNull
Case vbDecimal ' 14 Decimal.
Sql = Str(Value)
Case vbByte ' 17 Byte.
Sql = Str(Value)
Case LongLong ' 20 LongLong integer (Valid on 64-bit platforms only).
Sql = Str(Value)
Case vbUserDefinedType ' 36 Variants that contain user-defined types.
Sql = SqlNull
Case vbArray ' 8192 Array.
Sql = SqlNull
Case Else ' Should not happen.
Sql = SqlNull
End Select
CSql = Sql & " "
End Function

Insert Order to MS Access from VB6

i got one of our old VB application for training management.It was written in VB6 and the database is MsAccess.
When im using that application, while saving the training sessions ,all records are saved in between the previous records(not in order). It is not get added in last row. And also the application fetching the data from database and showed it in gridview. So the final display is in unsorted way.Like latest data which i was added using form,displaying in some where in middle row.
When i see the database table, all new data were get added in middle rows.
Here i will show the code:
sql = "INSERT INTO TrAssignment (BatchID,Category,CourseNumber,CourseTitle,FromDate,ToDate,Duration,Location, Trainer, FixedCost,DefaultStudentCost) VALUES ('" & CStr(txtBatchid.Text) & "','" & CStr(cmbCrscategory) & "','" & CStr(sCourNo) & "', '" & CStr(sCourTitle) & "','" & SchfromDTPick.Value & "','" & SchtoDTPicker.Value & "','" & CStr(txtSchduration.Text) & "','" & cmbLocation & "','" & CStr(cmbTrainer) & "','" & CStr(Trim(txtFixedcost.Text)) & "','" & CStr(Trim(txtDefault.Text)) & "')"
rs.Open sql, conn, adOpenDynamic, adLockOptimistic
And also the date format in form is like dd-mm-yyyy,for some records the date get saved in this exact format. But for some, the date format is like d/m/yyyy.
Just they are fetching the date from the date control,no formatting in code.
Your date format is wrong. In general, you could benefit from this function:
' Converts a value of any type to its string representation.
' The function can be concatenated into an SQL expression as is
' without any delimiters or leading/trailing white-space.
'
' Examples:
' SQL = "Select * From TableTest Where [Amount]>" & CSql(12.5) & "And [DueDate]<" & CSql(Date) & ""
' SQL -> Select * From TableTest Where [Amount]> 12.5 And [DueDate]< #2016/01/30 00:00:00#
'
' SQL = "Insert Into TableTest ( [Street] ) Values (" & CSql(" ") & ")"
' SQL -> Insert Into TableTest ( [Street] ) Values ( Null )
'
' Trims text variables for leading/trailing Space and secures single quotes.
' Replaces zero length strings with Null.
' Formats date/time variables as safe string expressions.
' Uses Str to format decimal values to string expressions.
' Returns Null for values that cannot be expressed with a string expression.
'
' 2016-01-30. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function CSql( _
ByVal Value As Variant) _
As String
Const vbLongLong As Integer = 20
Const SqlNull As String = " Null"
Dim Sql As String
Dim LongLong As Integer
#If Win32 Then
LongLong = vbLongLong
#End If
#If Win64 Then
LongLong = VBA.vbLongLong
#End If
Select Case VarType(Value)
Case vbEmpty ' 0 Empty (uninitialized).
Sql = SqlNull
Case vbNull ' 1 Null (no valid data).
Sql = SqlNull
Case vbInteger ' 2 Integer.
Sql = Str(Value)
Case vbLong ' 3 Long integer.
Sql = Str(Value)
Case vbSingle ' 4 Single-precision floating-point number.
Sql = Str(Value)
Case vbDouble ' 5 Double-precision floating-point number.
Sql = Str(Value)
Case vbCurrency ' 6 Currency.
Sql = Str(Value)
Case vbDate ' 7 Date.
Sql = Format(Value, " \#yyyy\/mm\/dd hh\:nn\:ss\#")
Case vbString ' 8 String.
Sql = Replace(Trim(Value), "'", "''")
If Sql = "" Then
Sql = SqlNull
Else
Sql = " '" & Sql & "'"
End If
Case vbObject ' 9 Object.
Sql = SqlNull
Case vbError ' 10 Error.
Sql = SqlNull
Case vbBoolean ' 11 Boolean.
Sql = Str(Abs(Value))
Case vbVariant ' 12 Variant (used only with arrays of variants).
Sql = SqlNull
Case vbDataObject ' 13 A data access object.
Sql = SqlNull
Case vbDecimal ' 14 Decimal.
Sql = Str(Value)
Case vbByte ' 17 Byte.
Sql = Str(Value)
Case LongLong ' 20 LongLong integer (Valid on 64-bit platforms only).
Sql = Str(Value)
Case vbUserDefinedType ' 36 Variants that contain user-defined types.
Sql = SqlNull
Case vbArray ' 8192 Array.
Sql = SqlNull
Case Else ' Should not happen.
Sql = SqlNull
End Select
CSql = Sql & " "
End Function