连接字符串将所有值作为文本传递

Connection string passing all values as text

我正在努力将数据导入 excel sheet 来自 text file with header line

文本文件中的值用制表符分隔,因此我必须创建 Schema.ini 文件,该文件保存在与文本文件相同的文件夹中:

[test no1.txt]
ColNameHeader=True
Format=TabDelimited
MaxScanRows=0
Col1="Column number 1" Float
Col2="Column number 2" Text
Col3="Column number 3" Text

我正在从文本文件中选择所有值到记录集中。然后,我使用此连接字符串打开目标 excel:

Public Function getXlsConn() As ADODB.Connection
    Dim rv As New ADODB.Connection
    Dim strConn As String

    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=" & targetFileName & ";" & _
    "Extended Properties=""Excel 12.0;HDR=YES;IMEX=0"";"

    rv.Open strConn
    Set getXlsConn = rv
End Function

我得到了目标记录集(范围在 excel sheet),我正在遍历源记录集的所有行(来自文本文件的数据)并将它们传递到目标记录集中。在循环结束时,我正在使用命令 UpdateBatch 更新目标记录集:

Sub CopyToXls(pRecordSet As ADODB.Recordset, pSheetName As String)
    Dim con As ADODB.Connection, rs As ADODB.Recordset
    Dim i As Long
    Dim size As Integer
    Dim fieldsArray() As Variant
    Dim values() As Variant

    Set con = getXlsConn()

    Set rs = New ADODB.Recordset

    rs.CursorLocation = adUseServer
    'header starts from 2nd row
    rs.Open "select *  from [" & pSheetName & "$A2:C600000]", con, _
             adOpenDynamic, adLockOptimistic

    'get number of columns and their names
    size = rs.Fields.Count - 1
    ReDim values(size)
    ReDim fieldsArray(size)
    For i = 0 To size
        fieldsArray(i) = rs.Fields(i).Name
    Next i

    'get end of file
    If rs.EOF = False Then
        rs.MoveFirst
    End If

    'copy rows from source recordset (text file) to target recordset (excel sheet)
    Do Until pRecordSet.EOF = True
            For i = 0 To size
                    values(i) = pRecordSet.Fields(i).Value
            Next i
            rs.AddNew fieldsArray, values
        pRecordSet.MoveNext
        rs.MoveNext
    Loop

    rs.UpdateBatch

    rs.Close
    Set rs = Nothing
    Set con = Nothing

End Sub

不幸的是,所有值 are passed as text,因此第一列的 SUM 函数(位于 A1 单元格中)不起作用。

我尝试更改连接字符串的 IMEX 参数 - 对于值 1 和 2 我收到错误 "Cannot update. Database object is read-only"。

我想传递与我在 Schema.ini 文件中定义的值完全相同的值。这可能吗?

这是连接到文本文档的一般方法。

我的示例文本文件如下所示:

1,a,b
1,a,b
1,a,b
1,a,b

为简单起见,我将分隔符设为逗号。

这是我正在使用的代码。特别注意,如果您有不同的定界符,则需要更改定界符类型。我注意到了那部分代码。

Public Sub OutputToExcel()
    Dim mySheet     As Worksheet: Set mySheet = ThisWorkbook.Sheets("Sheet1")
    Dim FolderPath  As String: FolderPath = "C:\Users\Megatron\Desktop\"
    Dim SQL         As String: SQL = "SELECT CDbl(F1) as Field1, " & _
                                     "Cstr(F2) as Text1, CStr(F3) as Text2 " & _
                                     "FROM MyFile.txt"

    Dim myRs        As ADODB.Recordset: Set myRs = New ADODB.Recordset
    Dim conn        As ADODB.Connection: Set conn = New ADODB.Connection

    'Change the FMT=Delimited to FMT=TabDelimited,
    'or continue using the schema.ini which I prefer
    Dim connstr     As String: connstr = "Provider=Microsoft.Ace.OLEDB.12.0;" & _
                                         "Data Source=" & FolderPath & _
                                         ";Extended Properties='text;HDR=No;FMT=Delimited';"
    'Open a connection
    With conn
        .connectionstring = connstr
        .Open
    End With

    'Read the data
    myRs.Open SQL, conn, adOpenForwardOnly, adLockOptimistic

    'Output the data
    mySheet.Range("A1").CopyFromRecordset myRs

    'Clean Up
    If myRs.State = adStateOpen Then myRs.Close: Set myRs = Nothing
    If conn.State = adStateOpen Then conn.Close: Set conn = Nothing
End Sub