我有一个 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
使用部分代码非常困难。
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 语句。
核心功能包括:
GetInsertSQL
:通过从 Excel 范围中提取数据来构建 SQL 语句,创建符合 SQL 的值行以插入到指定的表中。GetRowValues
:根据数据类型将每行数据转换为格式正确的 SQL 值 (DataTypeEnum
)。它处理文本、数字、日期和布尔值等数据类型,同时确保正确处理 NULL
和转义特殊字符。GetHeaderTypes
:根据传递给它的参数初始化数据类型数组 (DataTypeEnum
)。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