Sql server 将EXCEL数据导入SQL Server而不进行数据转换

Sql server 将EXCEL数据导入SQL Server而不进行数据转换,sql-server,excel,oledb,linked-server,openrowset,Sql Server,Excel,Oledb,Linked Server,Openrowset,我正在尝试将excel数据插入sql server表中。应使用用户在源Excel中编写的格式导入每一列 我正在使用以下查询获取数据 SELECT * FROM OPENROWSET( 'Microsoft.ACE.OLEDB.12.0', 'Excel 12.0 Xml;HDR=YES;IMEX=1;Database=H:\Loadloandata\Test\K3.xlsx', 'SELECT * FROM [Sheet1$]') 但是现在在excel的date列中,我们收到了一些来自用户的

我正在尝试将excel数据插入sql server表中。应使用用户在源Excel中编写的格式导入每一列

我正在使用以下查询获取数据

SELECT * FROM OPENROWSET( 'Microsoft.ACE.OLEDB.12.0', 'Excel 12.0 Xml;HDR=YES;IMEX=1;Database=H:\Loadloandata\Test\K3.xlsx', 
'SELECT * FROM [Sheet1$]')
但是现在在excel的date列中,我们收到了一些来自用户的浮点值格式问题,如下所示

由于数据无效,OLE提供程序会将所有其他日期转换为相应SQL表中的浮点值colums float values对应于每个日期。如果日期列自动转换为float,我将无法知道excel文件中数据的原始格式,因此所有列都应作为varchar导入

如何防止此数据类型转换?基于谷歌搜索,我在连接字符串中使用了IMEX=1来检索混合数据列的数据。
但它不起作用

您使用SSI有什么原因吗?我认为这最适合这份工作

无论如何,回到你的问题上来。IMEX=1是不够的。您需要的是检查注册表项

您需要在此注册表路径中设置TypeGuessRows和ImportMixedTypes这是用于32位office的!:

HKEY_LOCAL_MACHINE\SOFTWARE\WOW6432Node\Microsoft\Office\12.0\Access Connectivity Engine\Engines\Excel
TypeGuessRows=0默认值为8

ImportMixedTypes=文本

TypeGuessRows做什么? 它尝试根据定义的行数猜测数据类型。默认值为8。这意味着它将检查8行,看看应该使用什么数据类型。如果希望引擎扫描所有行,请将0放在那里。然而,有一个问题,如果您的电子表格很大,您可能会为这样的设置付出沉重的性能代价

ImportMixedTypes做什么? 这就是你的IMEX设置进入游戏的地方。IMEX设置0、1、2有3个可能的值:

0是导出模式 1是导入模式 2是链接模式完全更新功能 只有在设置IMEX=1时,才会使用注册表值。-默认设置为ImportMixedTypes=Text。在任何其他值0、2中,都会检查注册表中的值(如果该值有效),但不会影响结果。如果无效,您将得到一个错误

ImportMixedTypes有两个有效值:


大多数类型很少使用。它所做的是计算每列的类型,然后将多数类型用于整个列。文本类型将行大小限制为255个字符,如果您想使用更多字符,则必须使用多数类型,并且多数类型必须使用256个字符以上。

我认为您应该首先从SQL server表中获取数据类型以创建记录集,而不是让Excel从工作表中决定数据类型。我相信Excel是通过第一行决定数据类型的,所以在您的例子中,它假设数据是一个整数,然后将以下任何字符串强制转换为该数据类型

这是我使用的完整函数

这段代码由我从原始源代码中修改,注释中提到了这段代码。为了更好地处理错误,我做了一些更改


原因100亿为什么Excel作为数据源不好。。。我建议将Excel中该列的单元格类型更改为正确的日期或文本。@JacobH我们已经通知用户,但有时我们会收到相同的通知。.由于数据以批量形式出现,是否需要进行处理。.或任何其他替代方法?浮点数的整数部分是自1899年12月30日Excel-SQL Server使用以来的天数因此,您可以使用Select CASTEXCELDATECLUMN-2作为SmallDateTime进行转换。看,这对你有用吗?我希望看到你们方面的一些更新。@tukan它不起作用了……它仍在将日期值转换为浮点值
ImportMixedTypes=Text
ImportMixedTypes=Majority Type
    Function ExportRangeToSQL(ByVal sourcerange As Range, _
    ByVal conString As String, ByVal table As String, _
    Optional ByVal beforeSQL = "", Optional ByVal afterSQL As String) As String

    'https://www.excel-sql-server.com/excel-sql-server-import-export-using-vba.htm

    ' Object type and CreateObject function are used instead of ADODB.Connection,
    ' ADODB.Command for late binding without reference to
    ' Microsoft ActiveX Data Objects 2.x Library
    ' ADO API Reference
    ' https://msdn.microsoft.com/en-us/library/ms678086(v=VS.85).aspx
    ' Dim con As ADODB.Connection

    On Error GoTo Finalise ' throw friendly user connection error

    Dim con As Object
    Set con = CreateObject("ADODB.Connection")

    con.ConnectionString = conString
    con.Open


    Dim cmd As Object
    Set cmd = CreateObject("ADODB.Command")

    ' BeginTrans, CommitTrans, and RollbackTrans Methods (ADO)
    ' http://msdn.microsoft.com/en-us/library/ms680895(v=vs.85).aspx

    Dim level As Long
    level = con.BeginTrans

    cmd.CommandType = 1             ' adCmdText
    If beforeSQL > "" Then
        cmd.CommandText = beforeSQL
        cmd.ActiveConnection = con
        cmd.Execute
    End If

    ' Dim rst As ADODB.Recordset
    Dim rst As Object
    Set rst = CreateObject("ADODB.Recordset")

    With rst
        Set .ActiveConnection = con
        .Source = "SELECT * FROM " & table
        .CursorLocation = 3         ' adUseClient
        .LockType = 4               ' adLockBatchOptimistic
        .CursorType = 0             ' adOpenForwardOnly
        .Open

        ' Column mappings

        Dim tableFields(100) As Integer
        Dim rangeFields(100) As Integer

        Dim exportFieldsCount As Integer
        exportFieldsCount = 0

        Dim col As Integer
        Dim index As Variant

        For col = 0 To .Fields.Count - 1
            index = 0
            index = Application.Match(.Fields(col).Name, sourcerange.Rows(1), 0)
            If Not IsError(index) Then
                If index > 0 Then
                    exportFieldsCount = exportFieldsCount + 1
                    tableFields(exportFieldsCount) = col
                    rangeFields(exportFieldsCount) = index
                End If
            End If
        Next

        If exportFieldsCount = 0 Then
            Err.Raise 513, , "Column mapping mismatch between source and destination tables"
        End If

        ' Fast read of Excel range values to an array
        ' for further fast work with the array

        Dim arr As Variant
        arr = sourcerange.Value

        ' The range data transfer to the Recordset

        Dim row As Long
        Dim rowCount As Long
        rowCount = UBound(arr, 1)

        Dim val As Variant

        For row = 2 To rowCount
            .AddNew
            For col = 1 To exportFieldsCount
                val = arr(row, rangeFields(col))
                If IsEmpty(val) Then
                Else
                    .Fields(tableFields(col)) = val
                End If
            Next
        Next

        .UpdateBatch
    End With

    rst.Close
    Set rst = Nothing

    If afterSQL > "" Then
        cmd.CommandText = afterSQL
        cmd.ActiveConnection = con
        cmd.Execute
    End If



Finalise:
If con.State <> 0 Then
    con.CommitTrans
    con.Close
End If

Set cmd = Nothing
Set con = Nothing

' Raise appropriate custom errors

Select Case Err.Number
    Case -2147217843
        Err.Raise 513, , "Issue connecting to SQL server database - please check login credentials"

    Case -2147467259
        If InStr(1, Err.Description, "Server does not exist") <> 0 Then
            Err.Raise 513, , "Could not connect to SQL server, please check you are connected to the local network (in the office or on VPN)"
        Else
             Err.Raise 513, , "Issue connecting to SQL server database" & vbNewLine & Err.Description
        End If
    Case -2147217900
        If InStr(1, Err.Description, "'PK_XL_Eng_Projects_QuoteRef'") <> 0 Then
             Err.Raise 513, , "Quote already uploaded for this QuoteRef and Upload Time, please wait a minute before trying again" & vbNewLine & vbNewLine & Err.Description
         Else
            Err.Raise Err.Number, , Err.Description
         End If
    Case 0
        ' do nothing no error
    Case Else
        ' re raise standard error
         Err.Raise Err.Number, , Err.Description

End Select


End Function