“删除”后的fieldValue在VBA-SQL中显示为“0”以访问宏

问题描述 投票:0回答:1

我有一个 VBA 脚本,它根据 Excel 中的用户输入将 SQL 写入 ms-access。当前脚本将完美更新所有项目的数据库,但有一个例外。

如果用户在单元格中输入“150”,它将推送到适当的位置。如果用户向上推“ ”(空格),VBA 逻辑足够智能,可以向上推 NULL 值。如果有另一个号码(175),那么该号码将会更新。

在用户更新号码之前,他们会“拉下”后端数据以查看其中已有的内容。因此,如果用户拉下数据,并且“150”在数据库中,但他们只需单击 DELETE 来清除该数字并单击更新 - VBA-SQL 会推入 0 而不是 NULL。

我已经测试过它,问题是 VBA(在此文件中)将删除 fieldValue 读取为“0”而不是空白。因此,0 传递第一个循环逻辑(它不为空),并且 VBA 中的 len() 不适用于数字,而仅适用于文本。逻辑的第二步捕获 0,然后将 0 推高,因为它是数字。

我已经在一个基本的 Excel 文件(上传表单之外)中测试了这个循环逻辑,并且 SQL 被正确地写为 NULL。我不知道是否是导入然后上传部分创建了 0,但我找不到解决方法。

我还尝试在第一个循环中添加逻辑,如果“Or fieldValue = 0”则为 Null,这将起作用(!),但它也处理我让用户记录的“真零”值。我也尝试过'或 fieldValue = 0 AND len(fieldValue) = 0 (假零),但 len() 不适用于数字,即使在 Excel 中它会显示 ' 0 而不是 1 的“假零”(对于“真实”零)。

tl;博士,我认为问题是 Excel/VBA 在删除时保留初始化的单元格,并保留已删除的“150”号码中的一些行李。因此,输入 0 作为占位符而不是真正的空白。

  ' Get column names directly from the first row (assuming headers match exactly)
    columnNames = "[" & ws.Cells(1, 1).Value & "]"
    For j = 2 To columnCount
        columnNames = columnNames & ", [" & ws.Cells(1, j).Value & "]"
    Next j
    
    ' Loop through each row in the range
    For i = 1 To rng.Rows.Count
        
        ' Check if KPI column (Column A) is empty or contains ""
        If Trim(ws.Cells(i + 1, 1).Value) = "" Then
            ' Skip rows with empty KPI values
            GoTo SkipRow
        End If
        
        values = ""
        
        ' Loop through the columns (starting from column 1 to the last column)
        For j = 1 To columnCount
            
            ' Get the value of the current cell
            fieldValue = rng.Cells(i, j).Value
            
            ' Handle empty or uninitialized cells
            If IsEmpty(rng.Cells(i, j)) Or Len(Trim(fieldValue & "")) = 0 Then
                values = values & "NULL"
            
            ' Handle numeric values, including zero
            ElseIf IsNumeric(fieldValue) Then
                values = values & fieldValue
                
            ' Handle text fields (if any), escape single quotes, and add surrounding quotes
            Else
                values = values & "'" & Replace(fieldValue, "'", "''") & "'"
            End If
            
            ' Add a comma between values, except for the last one
            If j < columnCount Then
                values = values & ", "
            End If
        Next j
sql vba database ms-access
1个回答
0
投票

使用部分代码非常困难。

OP的代码输出

INSERT INTO Sales ([OrderDate], [Region], [Rep], [Item], [Units], [Unit Cost], [Total], [Policy]) VALUES (43471, 'East', 'Jones', 'Pencil', 95, 1.99, 189.05, 100953)
INSERT INTO Sales ([OrderDate], [Region], [Rep], [Item], [Units], [Unit Cost], [Total], [Policy]) VALUES (43488, 'Central', 'Kivell', 'Binder', 50, 19.99, 999.5, 100532)
INSERT INTO Sales ([OrderDate], [Region], [Rep], [Item], [Units], [Unit Cost], [Total], [Policy]) VALUES (43505, 'Central', NULL, NULL, 0, 0, 179.64, 100856)
INSERT INTO Sales ([OrderDate], [Region], [Rep], [Item], [Units], [Unit Cost], [Total], [Policy]) VALUES (43522, 'Central', 'Gill', 'Pen', 27, 19.99, 539.73, 100367)
INSERT INTO Sales ([OrderDate], [Region], [Rep], [Item], [Units], [Unit Cost], [Total], [Policy]) VALUES (43539, 'West', 0, 'Pencil', 0, 2.99, 167.44, 100602)

我的输出

INSERT INTO Sales (['OrderDate'], ['Region'], ['Rep'], ['Item'], ['Units'], ['Unit Cost'], ['Total'], ['Policy']) 
VALUES
(#2019-01-06#,'East','Jones','Pencil',95,1.99,189.05,'100953')
(#2019-01-23#,'Central','Kivell','Binder',50,19.99,999.5,'100532')
(#2019-02-09#,'Central',NULL,NULL,NULL,0,179.64,'100856')
(#2019-02-26#,'Central','Gill','Pen',27,19.99,539.73,'100367')
(#2019-03-15#,'West','0','Pencil',NULL,2.99,167.44,'100602'))

SQL INSERT 可以采用值数组。 这比每行运行 1 个 INSERT 语句更高效。 我也正确处理日期。

重构代码

此 VBA 代码根据 Excel 区域中的数据生成 SQL

INSERT INTO
语句。
Test_GetInsertSQL
过程调用主
GetInsertSQL
函数,该函数处理数据并构建 SQL 语句。

核心功能包括:

  1. GetInsertSQL
    :通过从 Excel 范围中提取数据来构建 SQL 语句,创建符合 SQL 的值行以插入到指定的表中。
  2. GetRowValues
    :根据数据类型将每行数据转换为格式正确的 SQL 值 (
    DataTypeEnum
    )。它处理文本、数字、日期和布尔值等数据类型,同时确保正确处理
    NULL
    和转义特殊字符。
  3. GetHeaderTypes
    :根据传递给它的参数初始化数据类型数组 (
    DataTypeEnum
    )。
  4. 枚举 (
    DataTypeEnum
    )
    :定义 SQL 字段的各种数据类型(例如,
    dbText
    dbDate
    dbCurrency
    )。

此结构允许基于 Excel 数据范围动态生成 SQL

INSERT
语句,并为不同字段类型提供适当的格式。

Option Explicit

Public Enum DataTypeEnum
    Rem Boolean (True/False)
    dbBoolean = 1           
    Rem Byte (0–255)
    dbByte = 2              
    Rem Integer (-32,768 to 32,767)
    dbInteger = 3           
    Rem Long Integer (-2,147,483,648 to 2,147,483,647)
    dbLong = 4              
    Rem Currency (-922,337,203,685,477.5808 to 922,337,203,685,477.5807)
    dbCurrency = 5          
    Rem Single precision floating point
    dbSingle = 6            
    Rem Double precision floating point
    dbDouble = 7            
    Rem Date/Time
    dbDate = 8              
    Rem Text (up to 255 characters)
    dbText = 10             
    Rem Binary data (up to 2 GB)
    dbLongBinary = 11       
    Rem Memo (up to ~65,536 characters)
    dbMemo = 12             
    Rem Globally Unique Identifier
    dbGUID = 15             
    Rem Big Integer (-9,223,372,036,854,775,808 to 9,223,372,036,854,775,807)
    dbBigInt = 16           
    Rem Variable-length binary data
    dbVarBinary = 17        
    Rem Decimal number
    dbDecimal = 20          
End Enum


Sub Test_GetInsertSQL()
    Rem Define the table name
    Const TableName As String = "Sales"
    Rem Get the header types using the GetHeaderTypes function
    Dim HeaderTypes() As DataTypeEnum
    HeaderTypes = GetHeaderTypes(dbDate, dbText, dbText, dbText, dbLong, dbCurrency, dbCurrency, dbText)
    Rem Store the result of GetInsertSQL function
    Dim Result As String
    Result = GetInsertSQL(Sheet3.Range("A1").CurrentRegion, TableName, HeaderTypes)
End Sub

Function GetInsertSQL(Source As Range, TableName As String, HeaderTypes() As DataTypeEnum) As String
    Rem Get the values from the source range
    Dim Data As Variant
    Data = Source.Value2
    
    Rem Initialize an array for storing values
    Dim Values As Variant
    ReDim Values(1 To UBound(Data))

    Rem Get the first row (headers)
    Dim RowValues As Variant
    RowValues = GetRowValues(Data, 1, HeaderTypes)
    Rem Construct the INSERT INTO SQL statement
    Values(1) = "INSERT INTO " & TableName & " ([" & Join(RowValues, "], [") & "]) " & vbNewLine & "VALUES"
    
    Rem Loop through the remaining rows for data
    Dim RowIndex As Long
    For RowIndex = 2 To UBound(Data)
        Rem Get the row values for each row
        RowValues = GetRowValues(Data, RowIndex, HeaderTypes)
        Rem Construct the SQL values part for each row
        Values(RowIndex) = "(" & Join(RowValues, ",") & ")"
    Next
    
    Rem Print the SQL statement to the Immediate window
    Debug.Print Join(Values, vbNewLine) & ")"
End Function

Function GetHeaderTypes(ParamArray Args()) As DataTypeEnum()
    Rem Initialize the result array
    Dim Result() As DataTypeEnum
    ReDim Result(1 To UBound(Args) + 1)
    
    Rem Loop through the arguments and assign them to the result array
    Dim n As Long
    For n = 0 To UBound(Args)
        Result(n + 1) = Args(n)
    Next
    
    Rem Return the result array
    GetHeaderTypes = Result
End Function

Function GetRowValues(ByRef Data As Variant, ByVal RowIndex As Long, HeaderTypes() As DataTypeEnum) As Variant()
    Rem Define the constant for NULL values
    Const NullText As String = "NULL"
    
    Rem Initialize the array for storing row values
    Dim RowValues() As Variant
    Dim Value As Variant
    Dim DataType As DataTypeEnum
    ReDim RowValues(1 To UBound(Data, 2))
    
    Rem Loop through each column in the row
    Dim c As Long
    For c = 1 To UBound(Data, 2)
        Rem Get the value and its data type
        Value = Data(RowIndex, c)
        DataType = HeaderTypes(c)
        
        Rem Force the first row to be text (for headers)
        If RowIndex = 1 Then DataType = dbText
        
        Rem Handle based on the DataTypeEnum
        Select Case DataType
            Rem Boolean field, handle as True/False
            Case dbBoolean
                If IsEmpty(Value) Then
                    Value = NullText
                Else
                    Value = IIf(CBool(Value), "True", "False")
                End If
            Rem Integer-like fields
            Case dbByte, dbInteger, dbLong, dbBigInt
                If IsNumeric(Value) Then
                    If Len(Value) = 0 Or Value = 0 Then
                        Value = NullText
                    End If
                Else
                    Value = NullText
                End If
            Rem Numeric fields, including currency and decimals
            Case dbCurrency, dbSingle, dbDouble, dbDecimal
                If IsNumeric(Value) Then
                    Value = Value
                Else
                    Value = NullText
                End If
            Rem Date field, format properly if it exists
            Case dbDate
                If Len(Value) > 0 Then
                    Value = "#" & Format(Value, "yyyy-mm-dd") & "#"
                Else
                    Value = NullText
                End If
            Rem Text fields, handle as string and escape single quotes
            Case dbText, dbMemo
                If Len(Value) = 0 Then
                    Value = NullText
                Else
                    Value = "'" & Replace(Value, "'", "''") & "'"
                End If
            Rem Default to NULL for any unknown or unsupported type
            Case Else
                Value = NullText
        End Select
        
        Rem Store the value in the RowValues array
        RowValues(c) = Value
    Next c
    
    Rem Return the row values array
    GetRowValues = RowValues
End Function
© www.soinside.com 2019 - 2024. All rights reserved.