0

I need to copy some data from SQL Server tables to similar Access tables with Excel VBA. For this I've created a function that creates Insert SQL to Access DB (PreparedStatement) based on the Select statement to SQL Server.

Things go pretty well with strings, dates and integers. How ever decimal values (adNumber type) are causing error "Data type mismatch in criteria expression". If I round the decimal values to integers things go smoothly. I've also confirmed that I can input decimal values to the target table manually using access.

Data type in original SQL Server source table fields is decimal(18,4) and in target Access table the corresponding type is Number (Decimal field type with precision 18 and scale 4). The code below sees the field as type adNumeric and NumericScale is 4 and Precision is 18.

For example when I read value 5.16 from the source table and try to insert it to target table I get an error. If I round the read value to 5 the insert works without an error.

So what am I doing wrong here and what should I do to get decimal numbers right?

I'm creating and executing the insert statement based on the select query as follows:

Private Sub AddToTargetDatabase(ByRef source As ADODB.Recordset, ByRef targetCn As ADODB.connection, tableName As String)
Dim flds As ADODB.Fields
Set flds = source.Fields
'target table is cleared at the beginning
targetCn.Execute ("DELETE FROM " & tableName)

Dim insertSQL As String
insertSQL = "INSERT INTO " & tableName & "("

Dim valuesPart As String
valuesPart = ") VALUES ("

Dim i As Integer

Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
Set cmd.ActiveConnection = targetCn
cmd.Prepared = True
Dim parameters() As ADODB.Parameter
ReDim parameters(flds.Count)

'Construct insert statement and parameters
For i = 0 To flds.Count - 1
    If (i > 0) Then
        insertSQL = insertSQL & ","
        valuesPart = valuesPart & ","
    End If
    insertSQL = insertSQL & "[" & flds(i).Name & "]"
    valuesPart = valuesPart & "?"
    Set parameters(i) = cmd.CreateParameter(flds(i).Name, flds(i).Type, adParamInput, flds(i).DefinedSize)
    parameters(i).NumericScale = flds(i).NumericScale
    parameters(i).Precision = flds(i).Precision
    parameters(i).size = flds(i).DefinedSize
    cmd.parameters.Append parameters(i)
Next i
insertSQL = insertSQL & valuesPart & ")"
Debug.Print insertSQL
cmd.CommandText = insertSQL

'String generated only for debug purposes
Dim params As String


Do Until source.EOF

    params = ""
    For i = 0 To flds.Count - 1
        Dim avalue As Variant


        If (parameters(i).Type = adNumeric) And Not IsNull(source.Fields(parameters(i).Name).Value) And parameters(i).Precision > 0 Then
            avalue = source.Fields(parameters(i).Name).Value
            'If rounded insert works quite nicely
            'avalue = Round(source.Fields(parameters(i).Name).Value)
        Else
            avalue = source.Fields(parameters(i).Name).Value
        End If

        'construct debug for the line
        params = params & parameters(i).Name & " (" & parameters(i).Type & "/" & parameters(i).Precision & "/" & source.Fields(parameters(i).Name).Precision & ") = " & avalue & "|"

        parameters(i).Value = avalue

    Next i
    'print debug line containing parameter info
    Debug.Print params
    'Not working with decimal values!!
    cmd.Execute
    source.MoveNext
Loop

End Sub
YowE3K
  • 23,852
  • 7
  • 26
  • 40
Jupe
  • 41
  • 1
  • 7

4 Answers4

0

I suppose that the problem with the decimals is that you are using a comma as a decimal symbol in Excel and in Access it is a dot. Simply to check whether this assumption is correct, do the following:

  • Click File > Options.
  • On the advanced tab, under Editing options, clear the Use system separators check box.
  • Type new separators in the Decimal separator and thousands separator boxes.

Then run it again. If it runs flawlessly, then this was the problem.

Edit: Can you do something like this: replace(strValue,",",".") to solve the problem in the place, where you pass the decimal value? I think it is here:

`insertSQL = insertSQL & "[" & replace(flds(i).Name,",",".") & "]"`
Vityata
  • 42,633
  • 8
  • 55
  • 100
  • My systems decimal separator is comma as you suspected. I did uncheck the Use system separators check box but it did not solve the issue. To be on the safe side I also added code block Application.DecimalSeparator = "." Application.UseSystemSeparators = False in the beginning of the procedure without any change in the functionality. Debug print out still formats decimals using commas though, so maby I'm missing something? – Jupe May 26 '17 at 08:35
  • @Jupe - see the edit. And you are not missing, the VBE editor is a bit strange. Even if you write in the editor `k=4.5` and then print it with `?k` it would show it with a comma. – Vityata May 26 '17 at 08:43
  • The line where you pointed in your edit contains only the field name not value. I'm using preparedStatements so the actual insert is something like INSERT INTO tableName (fieldName1,fieldName2) VALUES (?,?) the value is set to parameter at the line where it says parameters(i).Value = avalue I did try to change the decimal separator there but this would suggest that I use string that causes another error: "Application uses value of wrong type..." as the parameter is defined to be adNumeric type. – Jupe May 26 '17 at 09:40
0

Use Str to convert your decimals to a string representation for concatenating. Str always inserts a dot for the decimal separator.

Or use my 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
Gustav
  • 53,498
  • 7
  • 29
  • 55
  • Thanks for the suggestion. Converting a value to String did not help in this case as the Command objects' parameter was expecting numeric value. I finally resolved this by changing the parameter type to adDouble instead of adNumeric. – Jupe May 26 '17 at 10:55
0

Answering to my own question as after hours of trial-and-error I found a solution.

It seems that I needed to change the parameter field type in the cases where Select statement from SQL Server had type adNumeric with precision greater than 0. Changing the target Access DB query parameter type to adDouble instead of adDecimal or adNumber did the trick:

    Dim fieldType As Integer
    If (flds(i).Type = adNumeric And flds(i).Precision > 0) Then
        fieldType = adDouble
    Else
        fieldType = flds(i).Type
    End If
    Set parameters(i) = cmd.CreateParameter("@" & flds(i).Name, fieldType, adParamInput, flds(i).DefinedSize)
Jupe
  • 41
  • 1
  • 7
0

I've dealing with similar case and i solved following this steps. Sorry for my bad english i will try to do my best :)

I've created a temp excel sheet with all columns names like sql table in the first row. The data in this table is filled automatically when main table in main sheet is filled using formulas like =SI($B2="";"";MainSheet!$F15) or =SI($B2="";"";TEXTO(Fecha;"YYYY-DD-MM HH:mm:ss.mss")) in case of Date Time values. In case of Numbers =SI($B2="";"";VALOR(DECIMAL(MainSheet!AB15;2)))

After that, i've attached @Gustav to Modules with little modification to read "NULL" from the value of the cell to escape quotes.

    ' 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
            ElseIf Sql = "NULL" 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

Then I've attached Petrik's Code code to my module. But slightly modified.

Function Insert2DB(InputRange As Range, Optional ColumnsNames As Variant, Optional TableName As Variant)

      Dim rangeCell As Range
      Dim InsertValues As String
      Dim CellValue As String
      Dim C As Range

        Dim AllColls As String
        Dim SingleCell As Range
        Dim TableColls As String

    InsertValues = ""

    'Start Loop
    For Each rangeCell In InputRange.Cells

        CellValue = CSql(rangeCell.Value)
        'Debug.Print CellValue

    If (Len(InsertValues) > 0) Then
        InsertValues = InsertValues & "," & CellValue
    Else
        InsertValues = CellValue
    End If

    Next rangeCell
    'END Loop

    If IsMissing(ColumnsNames) Then
        TableColls = ""
        Else

        For Each SingleCell In ColumnsNames.Cells
            If Len(AllColls) > 0 Then
                     AllColls = AllColls & "," & "[" & Trim(Replace(SingleCell.Value, Chr(160), "")) & "]"
            Else
                    AllColls = "[" & Trim(Replace(SingleCell.Value, Chr(160), "")) & "]"
            End If
        Next SingleCell
        TableColls = " (" & AllColls & ")"
    End If


    'If TableName is not set, then take the name of a sheet
    If IsMissing(TableName) = True Then
        TableName = ActiveSheet.Name
    Else
    TableName = TableName
    End If

    'Set the return value
        Insert2DB = "INSERT INTO " & TableName & TableColls & " VALUES (" & InsertValues & ") "

    End Function

CellValue = CSql(rangeCell.Value) do the trick

I've added in my temp sheet a last column with =SI(A2<>"";Insert2DB(A2:W2;$A$1:$W$1;"sql_table");"")

In the macro where i run to export to SQL

With Sheets("tempSheet")



' Column where Insert2DB formula is

Excel_SQLQuery_Column = "X"

'Skip the header row
iRowNo = 2

'Loop until empty cell
Do Until .Cells(iRowNo, 1) = ""



    iRowAddr = Excel_SQLQuery_Column & iRowNo

    SQLstr = .Range(iRowAddr).Value

    Cn.Execute (SQLstr)

    iRowNo = iRowNo + 1

Loop

End With

That's worked for me so good. Thank you @Gustav and @Petrik to share his code.

Chiar15
  • 1
  • 1