Невозможно объединить две таблицы, даже если ADODB подтверждает одинаковое количество полей - PullRequest
0 голосов
/ 24 августа 2018

Я не могу объединить два csvs, хотя ADODB через .Fields.Count подтверждает, что они имеют одинаковое количество столбцов.

Вот запрос, который не выполняется:

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


Иллюстрирование создания schema.ini для @Comintern:

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

1 Ответ

0 голосов
/ 29 августа 2018

С помощью @ Коминтерна я смог увидеть, что совершил глупую ошибку, не имея ничего общего с действительным названием вопроса.Вы можете видеть выше, что мой метод CreateSchemaIni создавал и затем переписывал файл Schema.ini для каждого CSV, который я запрашивал, а не создавал и затем добавлял к нему.Изменяя этот метод для использования Open For Append вместо Open For Output, проблема была решена.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...