Question

我正在努力将数据导入excel表格 text file with header line

文本文件中的值用tab分隔，因此我必须创建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表中的范围），我循环遍历源记录集的所有行（来自文本文件的数据）并将它们传递到目标记录集。在循环结束时，我使用命令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我收到错误“无法更新。数据库对象是只读的”。

我想完全按照我在Schema.ini文件中定义的值传递值。这可能吗？

Answer 1

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

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

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

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

1 个答案: