Question

即使ADODB通过.Fields.Count确认它们具有相同的列数，我也无法合并两个csv。

这是失败的查询：

select * from csv1.csv union select * from csv2.csv

，并显示错误消息：

两个选定的表或联合查询中的列数不匹配

但是，当我分别执行select * from csv1.csv和select * from csv2.csv时，ADODB会确认两个字段的.Fields.Count = 8。

问题的可能关键：

我需要创建两个单独的连接吗？即使查询中有两个csv，我也只能创建一个连接（到第一个csv）。

我试图弄清楚如何为同一个查询建立两个独立的连接，人们似乎并没有发现必要的必要-我找不到在人们针对csvs运行的同等查询中提到的两个连接。

按照@Parfait的要求查看更多代码：

GetDataFromCSV

Public Function GetDataFromCSV(ByVal fileReport As Scripting.File, ByVal strQuery As String, ByVal arrSourceReports As Variant) As Boolean

    Dim strRevisedQuery As String
    strRevisedQuery = GetRevisedQueryWithFileAliasesReplacedWithTrueFileNames(strQuery, arrSourceReports)

    Dim cnn As ADODB.Connection
    Set cnn = OpenConnectionToCSV(fileReport)
    If cnn Is Nothing Then
        GetDataFromCSV = False
        Exit Function
    End If

    GetDataFromCSV = QueryDataFromCSV(cnn, strRevisedQuery, fileReport.Name, fileReport.Name)

End Function

OpenConnectionToCSV

Private Function OpenConnectionToCSV(ByVal fileCSV As Scripting.File, Optional boolHeadersPresent As Boolean = True) As ADODB.Connection

    Dim cnn As ADODB.Connection
    Set cnn = New ADODB.Connection
    cnn.ConnectionTimeout = 0

    Dim strfileCSVParentFolderPath As String
    strfileCSVParentFolderPath = fileCSV.ParentFolder
    If Right(strfileCSVParentFolderPath, 1) <> Application.PathSeparator Then strfileCSVParentFolderPath = strfileCSVParentFolderPath & Application.PathSeparator

    Dim strConn As String
    If boolHeadersPresent = False Then
        strConn = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strfileCSVParentFolderPath & ";Extended Properties=""text;HDR=NO;FMT=Delimited"""
    Else
        strConn = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strfileCSVParentFolderPath & ";Extended Properties=""text;HDR=YES;FMT=Delimited"""
    End If

    If strConn <> vbNullString Then
        On Error GoTo ErrorHandler
        Dim lngRetryCount As Long
        lngRetryCount = 0
        cnn.Open strConn
        On Error GoTo 0

        Set OpenConnectionToCSV = cnn
    End If

    Exit Function


ErrorHandler:
    Select Case True
        Case InStr(1, Err.Description, "Connect timeout occurred", vbTextCompare) > 0
            If lngRetryCount < 30 Then
                Application.Wait DateAdd("s", 1, Now)
                lngRetryCount = lngRetryCount + 1
                Resume
            Else
                MsgBox "Can't connect to " & fileCSV.Path & ". Reading this file will be skipped."
                Exit Function
            End If
        Case Else
            MsgBox "Getting data from " & fileCSV.Name & " has failed with the following error message: " & Err.Number & ": " & Err.Description
            On Error GoTo 0
            Resume
    End Select

End Function

QueryDataFromCSV

Private Function QueryDataFromCSV(ByVal cnn As ADODB.Connection, ByVal strQuery As String, ByVal strCSVName As String, ByVal strFinalReportTitle As String) As Boolean

    QueryDataFromCSV = True

    Dim cmd As ADODB.Command
    Set cmd = PrepareQueryCommand(cnn, strQuery)
    CreateQueryDebugLog cmd.CommandText

    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    rst.Open cmd

    Dim Loop1 As Long
    With rst
        For Loop1 = 1 To .Fields.Count
            If .Fields(Loop1 - 1).Name = "F" & Loop1 Then
                If Loop1 < 4 Then
                    MsgBox "Can't retrieve data from " & strCSVName & " because it is formatted improperly."
                Else
                    MsgBox "Can't retrieve data from " & strCSVName & " because it is delimited improperly. The file is most likely delimited with a comma even though it has addresses or other fields that contain commas. Ask Encounters IT to change this report's delimiter to another character, such as | (pipe), in the Tidal batch file."
                End If

                QueryDataFromCSV = False
                Exit Function
            End If
        Next Loop1
    End With

    CopyThisCSVRecordsetToResultSheets rst, strFinalReportTitle
    cnn.Close
    Set rst = Nothing
    Set cmd = Nothing
    Set cnn = Nothing

End Function

上述功能rst.Open cmd中的QueryDataFromCSV发生了错误

说明为@Comintern创建schema.ini：

GetRevisedQueryWithFileAliasesReplacedWithTrueFileNames

Private Function GetRevisedQueryWithFileAliasesReplacedWithTrueFileNames(ByVal strQuery As String, ByVal arrSourceReports As Variant) As String

    Dim FSO As Scripting.FileSystemObject
    Set FSO = New Scripting.FileSystemObject

    Dim lngPosition As Long
    lngPosition = 0

    Do Until lngPosition > Len(strQuery)
        Dim lngStartPosition As Long
        lngStartPosition = InStr(lngPosition + 1, strQuery, "from", vbTextCompare) + 5
        If lngStartPosition > lngPosition Then
            Dim lngEndPosition As Long
            lngEndPosition = InStr(lngStartPosition + 1, strQuery, " ", vbTextCompare)
            If lngEndPosition = 0 Then lngEndPosition = Len(strQuery) + 1

            Dim strSourceReportTitle As String
            strSourceReportTitle = Mid(strQuery, lngStartPosition, lngEndPosition - lngStartPosition)

            Dim Loop2 As Long
            For Loop2 = LBound(arrSourceReports, 1) To UBound(arrSourceReports, 1)
                If arrSourceReports(Loop2, 1) = strSourceReportTitle Then Exit For
            Next Loop2

            Dim fileSource As Scripting.File
            Set fileSource = FSO.GetFile(arrSourceReports(Loop2, 3))

            If arrSourceReports(Loop2, 2) = "TAB" Then arrSourceReports(Loop2, 2) = Chr(9)
            CreateSchemaIni fileSource, arrSourceReports(Loop2, 2)

            Dim strRevisedQuery As String
            If strRevisedQuery = vbNullString Then
                strRevisedQuery = Replace(strQuery, "from " & strSourceReportTitle, "from " & fileSource.Name)
            Else
                strRevisedQuery = Replace(strRevisedQuery, "from " & strSourceReportTitle, "from " & fileSource.Name)
            End If

            lngPosition = lngEndPosition
        Else
            lngPosition = Len(strQuery) + 1
        End If
    Loop

    GetRevisedQueryWithFileAliasesReplacedWithTrueFileNames = strRevisedQuery

End Function

CreateSchemaIni

Private Sub CreateSchemaIni(ByVal fileReport As Scripting.File, ByVal strDelimiter As String)

    Dim intSystemFileNumber As Integer
    intSystemFileNumber = FreeFile()
    On Error GoTo ErrorHandler
    Open fileReport.ParentFolder.Path & Application.PathSeparator & "Schema.ini" For Output As #intSystemFileNumber
    Print #intSystemFileNumber, "[" & fileReport.Name & "]"
    Print #intSystemFileNumber, "Format=Delimited(" & strDelimiter & ")"
    Close #intSystemFileNumber

    Exit Sub


ErrorHandler:
    Select Case True
        Case InStr(1, Err.Description, "Path/File Access Error", vbTextCompare) > 0
            Dim strStandardQueryDebugLogPath As String
            strStandardQueryDebugLogPath = fileReport.ParentFolder.Path & Application.PathSeparator & "strQuery.txt"
            MsgBox strStandardQueryDebugLogPath & " was inaccessible. Creating log in same folder where your copy of the Mass Queryer is saved instead."
            Open Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, Application.PathSeparator, , vbTextCompare)) & "strQuery.txt" For Output As #intSystemFileNumber
            Print #intSystemFileNumber, "[" & fileReport.Name & "]"
            Print #intSystemFileNumber, "Format=Delimited(" & strDelimiter & ")"
            Close #intSystemFileNumber
            Exit Sub
        Case Else
            MsgBox "Creating a query debug log has failed with the following error message: " & Err.Number & ": " & Err.Description
            On Error GoTo 0
            Resume
    End Select

End Sub

Answer 1

在@Comintern的帮助下，我发现自己犯了一个愚蠢的错误，实际上与问题标题无关。您可以在上面看到我的CreateSchemaIni方法正在创建，然后为我正在查询的每个csv覆盖了Schema.ini文件，而不是创建然后附加到该文件。通过将该方法更改为使用Open For Append而不是Open For Output，问题得以解决。

即使ADODB确认相等的字段计数也无法合并两个表

1 个答案: