Question

下面的例程使用ADO读入csv文件。我正在阅读的csv文件有139,000行数据，有136列。例程没有按预期工作。其中一列的所有行的值都为零，除了500行左右，其中取十进制值，例如0.05或0.03等。因为此方法使用ADO，它使用设置确定字段的数据类型注册表，TypeGuessRows，其中，基于预先指定的行数，它猜测该列的数据类型。因此，对于示例中的列，我认为它假定为整数数据类型，因为前几百个值都为零。然后强制少数十进制和非零的值适合假定的数据类型，因此也变为零。我无法更改TypeGuessRows的值，因为在我工作的公司中，我没有权限更改注册表。在136列中，还有许多其他列具有类似的问题。

有解决方法吗？我已经看到一个建议，我可以使用虚拟的第一行，其值将暗示所需的数据类型，但这是一个我宁愿不会产生的开销。

或者我只需要使用不使用ADO的数据导入方法吗？

Sub GetDataTextFile1(strFilePath As String, strSheet As String, strRange As String, strField As String, strValue As String)

    Dim strFolder As String, strFile As String, strSQL As String
    Dim objConnection As ADODB.Connection
    Dim objRecordSet As ADODB.Recordset

    'If an error occurs then handle it
    'On Error GoTo ErrorTrap

    'Get the name of the file and the folder
    strFile = Right(strFilePath, Len(strFilePath) - InStrRev(strFilePath, "\"))
    strFolder = Left(strFilePath, Len(strFilePath) - Len(strFile) - 1)

    Set objConnection = New ADODB.Connection
    Set objRecordSet = New ADODB.Recordset

    'Open Connection
    objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
                        & "Data Source=" & strFolder & ";" _
                        & "Extended Properties=""text;HDR=YES;FMT=Delimited"""

    'Generate SQL code to extract data from the file
    If strField <> "" And strValue <> "" Then
        strSQL = "SELECT * FROM [" & strFile & "] WHERE CSTR([" & strField & "]) IN ('" & strValue & "');"
    Else
        strSQL = "SELECT * FROM [" & strFile & "];"
    End If

    'Execute the SQL code
    Set objRecordSet = objConnection.Execute(strSQL)

    'Copy the data in to the relevant range in the spreadsheet
    ThisWorkbook.Sheets(strSheet).Range(strRange).CopyFromRecordset objRecordSet

    'Close the recordset and the connection to the database
    objRecordSet.Close
    objConnection.Close

    Set objRecordSet = Nothing
    Set objConnection = Nothing

ExitPoint:
    Exit Sub

ErrorTrap:
    Call ErrorHandler(Err.Number, Err.Description, "GetDataTextFile1")

End Sub

Answer 1

替换

行

 ThisWorkbook.Sheets(strSheet).Range(strRange).CopyFromRecordset objRecordSet

使用以下

Dim r as range
Dim f as field
dim x as long
Set r = ThisWorkbook.Sheets(strSheet).Range(strRange)
Do while not objrecordset.eof
     x = 0
     For each f in objrecordset.fields
        r.offset(0,x) = objrecordset(x)
        x = x +1
    next f
    objrecordset.movenext
    set r = r.offset(1,0)
loop

这将逐位引入数据。如果这不足以避免猜测数据类型，可以添加一个select case f.name例程来强制某些字段的数据类型

Answer 2

您可以使用以下脚本导入CSV，甚至多个CSV文件。

Sub ReadFilesIntoActiveSheet()

    Dim fso As FileSystemObject
    Dim folder As folder
    Dim file As file
    Dim FileText As TextStream
    Dim i As Long
    Dim cl As Range

    Set fso = New FileSystemObject
    Set folder = fso.GetFolder("C:\Users\Excel\Desktop\test\")

    Set cl = ActiveSheet.Cells(1, 1)

    Application.ScreenUpdating = False

    For Each file In folder.Files

        Set FileText = file.OpenAsTextStream(ForReading)
        cl.Value = file.Name
        i = 1

        Do While Not FileText.AtEndOfStream
            cl.Offset(i, 0).Value = FileText.ReadLine
            i = i + 1
        Loop

        FileText.Close

        Set cl = cl.Offset(0, 1)
    Next file

    Application.ScreenUpdating = True

    Set FileText = Nothing
    Set file = Nothing
    Set folder = Nothing
    Set fso = Nothing

End Sub

使用ADO

2 个答案: