Импорт данных Excel с SQL-запросом в VBA перепрыгивает через первую строку - PullRequest
Новая
       7

Импорт данных Excel с SQL-запросом в VBA перепрыгивает через первую строку

0 голосов
/ 08 октября 2018

Я пытаюсь скопировать данные из одной книги 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 голосов
/ 08 октября 2018

Проблема в том, что 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 -статменте, в противном случае вам придется обращаться к ним по символам столбца.

...