在MS-Access

时间:2016-10-19 09:54:52

标签: sql vba ms-access export insert-into

我喜欢将数据(单个记录)从一个Access数据库导出到另一个国家/地区的另一个数据库。我的想法是,我希望每封电子邮件发送一个包含INSERT INTO语句的文本文件,接收PC只执行这些INSERT INTO语句。我已经编写了代码来读取和执行这些文本文件中的INSERT INTO语句。

显然我必须生成INSERT INTO语句。

这是一个例子。

我有下表:

Table1
Id                number
PersonName        text
DoB               date, can be empty
NumberOfChildern  number, can be empty

我选择这样的数据:

SELECT Id, PersonName, DoB, NumberOfChildern FROM Table1;

我想要生成的是这样的语句:

INSERT INTO Table1 (Id, PersonName, DoB, NumberOfChildern ) VALUES (1, ‘Peter’, #5-17-1990#, 1)

如果所有字段都被填写,那么我可以写一次代码就可以了。但是如果有几个字段可能包含数据或者没有数据,则会出现问题。

以上是上述陈述的一些相似但不同的版本:

INSERT INTO Table1 (Id, PersonName, DoB, NumberOfChildern ) VALUES (1, ‘Peter’, #5-17-1990#, 1)
INSERT INTO Table1 (Id, PersonName, NumberOfChildern ) VALUES (1, ‘Peter’, 1)
INSERT INTO Table1 (Id, PersonName, DoB ) VALUES (1, ‘Peter’, #5-17-1990#)
INSERT INTO Table1 (Id, PersonName ) VALUES (1, ‘Peter’)

只有两个字段可以包含NULL值,这个语句已经有4个不同的版本,并且有更多字段,它变得越来越复杂(不是很复杂,但更多的工作)。

我考虑在VBA中编写代码,分析表和我想要导出的记录以检查使用哪种字段(即日期),然后生成如上所述的语句。 我相信我能做到这一点,但我想知道其他人是否可以做到这一点。 我不想重新发明轮子。 但是搜索"生成SQL插入语句"效率不高。

有什么想法吗?

1 个答案:

答案 0 :(得分:3)

这是你的幸运日。我已经为SQL Server做了这个 - 在下面做了一些修改,它应该适用于Access SQL。

关键是插入VALUES NULL,如果值为null,则不创建不同的语句。

访问可能不需要SET IDENTITY_INSERT ON/OFF

Gustav发布了一个generic function,可以替换所有Sqlify / SqlDate等辅助函数,并涵盖更多数据类型。

Public Sub InsertStatementsSql(ByVal sTABLE As String)

    Dim DB As DAO.Database
    Dim TD As DAO.TableDef
    Dim RS As DAO.Recordset
    Dim fld As DAO.Field
    Dim sKpl As String
    Dim sStart As String
    Dim sValues As String
    Dim S As String
    Dim v As Variant
    Dim i As Long
    Dim bIdentity As Boolean

    Set DB = CurrentDb
    Set TD = DB.TableDefs(sTABLE)
    Set RS = DB.OpenRecordset(sTABLE, dbOpenSnapshot)


    ' Check for Autonumber/IDENTITY column
    bIdentity = False
    For i = 0 To TD.Fields.count - 1
        If (TD.Fields(i).Attributes And dbAutoIncrField) > 0 Then
            bIdentity = True
            Exit For
        End If
    Next i

    If bIdentity Then
        sKpl = sKpl & "SET IDENTITY_INSERT " & sTABLE & " ON;" & vbCrLf & vbCrLf
    End If

    ' "INSERT INTO ... VALUES " for every line
    For i = 0 To TD.Fields.count - 1
        sStart = StrAppend(sStart, TD.Fields(i).Name, ", ")
    Next i
    sStart = "INSERT INTO " & sTABLE & " (" & sStart & ") VALUES "

    ' One line per record
    Do While Not RS.EOF
        sValues = ""
        For i = 0 To TD.Fields.count - 1
            v = RS(i)
            If IsNull(v) Then
                S = "NULL"
            Else
                Set fld = TD.Fields(i)
                Select Case fld.Type
                    Case dbText, dbMemo: S = Sqlify(CStr(v))
                    Case dbDate: S = SqlDate(CDate(v))
                    Case dbDouble, dbSingle: S = SqlNumber(CDbl(v))
                    Case Else: S = CStr(v)
                End Select
            End If
            sValues = StrAppend(sValues, S, ", ")
        Next i
        ' Append line to full SQL
        sKpl = sKpl & vbCrLf & sStart & " (" & sValues & ");"
        RS.MoveNext
    Loop
    RS.Close
    Set TD = Nothing

    If bIdentity Then
        sKpl = sKpl & vbCrLf & vbCrLf & "SET IDENTITY_INSERT " & sTABLE & " OFF;" & vbCrLf
    End If

    Debug.Print sKpl

    ' see https://support.microsoft.com/en-us/kb/210216 or https://msdn.microsoft.com/en-us/library/office/ff192913.aspx
    ' or https://stackoverflow.com/a/25431633/3820271
    'ClipBoard_SetData sKpl

End Sub

' ------------------- helper functions -----------------

'  ein'string --> 'ein''string'
Public Function Sqlify(ByVal S As String) As String

    S = Replace(S, "'", "''")
    S = "'" & S & "'"
    Sqlify = S

End Function

Public Function SqlDate(vDate As Date) As String
    SqlDate = "#" & Format(vDate, "yyyy-mm-dd") & "#"
End Function

Public Function SqlNumber(num As Double) As String
    SqlNumber = Replace(CStr(num), ",", ".")
End Function

Public Function StrAppend(sBase As String, sAppend As Variant, sSeparator As String) As String

    If Len(sAppend) > 0 Then
        If sBase = "" Then
            StrAppend = Nz(sAppend, "")
        Else
            StrAppend = sBase & sSeparator & Nz(sAppend, "")
        End If
    Else
        StrAppend = sBase
    End If

End Function