即使 ADODB 确认字段计数相等，也无法合并两个表
Can't union two tables even though ADODB confirms equal field counts
我无法合并两个 csvs，即使 ADODB 通过 .Fields.Count 确认它们都具有相同的列数。
这是失败的查询：
select * from csv1.csv union select * from csv2.csv
错误信息：
The number of columns in the two selected tables or queries of a union query do not match
但是，当我分别执行 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
The error is occurring at rst.Open cmd in the above function 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
在@Comintern 的帮助下，我发现我实际上犯了一个与问题标题无关的愚蠢错误。您可以在上面看到我的 CreateSchemaIni 方法正在为我正在查询的每个 csv 创建然后覆盖 Schema.ini 文件，而不是创建然后附加到它。通过将该方法更改为使用 Open For Append 而不是 Open For Output，问题得到解决。
我无法合并两个 csvs，即使 ADODB 通过 .Fields.Count 确认它们都具有相同的列数。
这是失败的查询：
select * from csv1.csv union select * from csv2.csv
错误信息：
The number of columns in the two selected tables or queries of a union query do not match
但是，当我分别执行 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
The error is occurring at
rst.Open cmdin the above functionQueryDataFromCSV
为@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
在@Comintern 的帮助下，我发现我实际上犯了一个与问题标题无关的愚蠢错误。您可以在上面看到我的 CreateSchemaIni 方法正在为我正在查询的每个 csv 创建然后覆盖 Schema.ini 文件，而不是创建然后附加到它。通过将该方法更改为使用 Open For Append 而不是 Open For Output，问题得到解决。