在VBA中使用SQL查询导入Excel数据会跳过第一行

时间:2018-10-08 07:56:58

标签: sql excel vba import adodb

我正在尝试将数据从一个excel工作簿复制到另一个。为此,我正在使用ADODB连接。通过SQL查询,我将所有数据从所需的工作表复制到其他工作簿。但是,由于某种原因,它会跳过每张纸中的第一行。因此,复制的数据始终从第2行开始。 也许你们其中一位可以发现我的错误或向我解释为什么会发生这种情况?

Sub ImportExcelSQL()

Dim sheetName, sheetNewName, filepath, strConnection, Sql As String
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset

'-------- Close workbook updates ----------
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Application.StatusBar = "Importing...."
'------------------------------------------

filepath = Range("filepath")

strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
                  & "DBQ=" + filepath + ";"

' Create the Connection and Recordset objects.
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset

' Open connection
conn.Open strConnection

' Loop through the sheets
Dim i As Integer
i = 1
Do Until IsEmpty(Range("importSheetNames").Offset(i, 0))

    If Range("importSaveSheetFlags").Offset(i, 0).Value = "Y" Then

    ' Get sheet names and input variables"
    sheetName = Range("importSheetNames").Offset(i, 0).Value
    sheetNewName = Range("exportSheetNames").Offset(i, 0).Value
    filepath = Range("filepath")

    ' Clear data sheet
    Sheets(sheetNewName).UsedRange.ClearContents

    ' ----------------------- SQL CODE ----------------------------
    Sql = "SELECT * FROM [" + sheetName + "$A:CA]"
    'Sql = "SELECT * FROM [" + sheetName + "$A1:CA1000]" 'Does not do any difference

    ' Open the connection and execute.
    'conn.Open strConnection
    Set rs = conn.Execute(Sql)

    ' Check we have data.
    If Not rs.EOF Then
       ' Transfer result.
       Sheets(sheetNewName).Range("A1").CopyFromRecordset rs
       ' Close the recordset
       rs.Close
    Else
       MsgBox "Error: No records returned.", vbCritical
    End If

    ' -------------- End of SQL --------------------------------------------

    End If


    i = i + 1
Loop

' Clean up
If CBool(conn.State And adStateOpen) Then conn.Close
Set conn = Nothing
Set rs = Nothing

'-----------------------------------------------
' Turn on automatic updating
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
Application.StatusBar = "Finished"
'-----------------------------------------------

End Sub

1 个答案:

答案 0 :(得分:1)

问题是Excel(或更准确地说,是驱动程序)期望源数据的第一行包含标题行(保存列名)。

理论上,连接字符串中有一个参数,用于定义是否有标题行HDR=YES;,但是对于该驱动程序似乎忽略了该参数,而是从注册表中获取了一个值被读取。参见https://stackoverflow.com/a/49555650/7599798

或者,您可以使用OLE驱动程序:尝试

strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & filepath _ 
              & ";Extended Properties=""Excel 12.0 Xml;HDR=NO;"""

这尊重HDR的设置,因此,如果您写HDR=NO,它将复制第一行,而HDR=YES则跳过它。如果有标题行,则可以在SQL语句中按其名称访问列,否则必须按列字符进行访问。