SQL-Ex blog

Тут предполагается, что ваши данные не представляют собой перекрестную (пивот) таблицу.

Установка

Начнем с создания макроса в Excel. На вкладке “Developer” ленты (ее может не быть по умолчанию; вы можете добавить ее из меню Options) щелкните кнопку “View Code” (для Windows можно использовать комбинацию клавиш Alt+F11).

В верхнем меню: Insert >> Module



На новой панели (где печатается код) создайте функцию public:

Public Function ImportData()

End

Если вы напечатаете “public function ImportData” нажмете Enter, остальное будет добавлено автоматически; т.е. будут добавлены круглые скобки и ключевое слово End.

Не забудьте сохранить ваш файл с расширением .xlsm, т.к. это книга с включенными макрокомандами (а не "обычная" книга).

Обзор концепции

Мы будем выполнять оператор INSERT в следующем формате:

INSERT INTO myTableName 

   (field1, field2) 

VALUES 

   (row1Value1, row1Value2),

   (row2Value1, row2Value2)

Разобьем это на 2 части:

• Заголовок SQL (INSERT INTO myTableName)


• Динамически сгенерированные "values", представляющие собой конкатенацию отдельных строк данных из электронной таблицы.

Давайте напишем код!

Сначала нужно создать строку подключения. Я оставляю точное значение вам. Вы, конечно, должны убедиться, что пользователь имеет необходимые разрешения безопасности базы данных. В примере ниже используется Active Directory - поэтому он обнаруживает мой вход в Windows и не использует локальную учетную запись пользователя SQL.

Я подключаюсь через ODBC. Если на вашей машине не установлен драйвер, загрузите его.

В моем случае строка подключения выглядит так:

Const strDbConn As String = "server=myServerName;Database=myDatabaseName;Trusted_Connection=Yes;Driver={ODBC Driver 17 for SQL Server}"

Для этого я создал глобальную переменную, размещенную выше объявления функции, которое мы только что создали.

Глобальную переменную мы можем использовать и в других функциях.

У меня есть простая функция для выполнения SQL:

Public Function RunSQL(strDbConn As String, strSQL As String)

    Dim cnn As Object

    Dim rst As Object   

    Set cnn = CreateObject("ADODB.Connection")

    cnn.Open strDbConn

    Set rst = CreateObject("ADODB.Recordset")

    rst.Open strSQL, cnn, 3, 1 '3 = Keyset, 1 = Pessimistic   

    Set rst = Nothing

End Function

Ошибка ADODB?

Этот код работает у меня без необходимости добавлять внешне ссылки. Но если вы получаете ошибку...

Раньше - возможно, это была предыдущая версия Excel - мне требовалось добавить ссылку, чтобы использовать код ADODB.

Вы можете сделать это в меню Tools >> References:



Согласно этой статье, вам нужно снять флажок опции Microsoft ActiveX Data Objects [x.x] Library.

Вставка данных с помощью SQL: заголовок

Нам нужно создать начальную часть оператора SQL, которая будет статичной (т.е. не будет изменяться).

Создадим функцию , которая возвращает жестко закодированный результат первой части оператора INSERT для заданной таблицы и имен полей:

Public Function GetInsertHeader() As String

    Dim strHeader  As String

    strHeader = ""

    strHeader = strHeader & " INSERT INTO myTableName ("

    strHeader = strHeader & " [field_one]"

    strHeader = strHeader & " ,[field_two]"

    strHeader = strHeader & " ,[field_three]"

    strHeader = strHeader & " )"

    GetInsertHeader = strHeader

End Function

Конечно, вам нужно изменить имена таблицы и полей

Вставка данных с помощью SQL: сами данные

Нам нужен способ для динамической генерации values, которые будут вставляться в базу данных. Прежде чем создать SQL, нам нужен способ прохода по всем строкам в Excel сверху донизу. На первом шаге нужно определить, сколько строк у нас есть.

Я использую функцию ниже для получения числа строк в электронной таблице.

Я определяю тип LONG, поскольку Integer (целое) недостаточно велик для моего набора данных. Целое ограничено 32000 строками.

Public Function HowManyRows(sheetName As String) As Long

    'Find out how many row there are

    ' Assumes the first column does NOT have a blank in it 

    Sheets(sheetName).Select

    Range("A1").Select

    Selection.End(xlDown).Select

    Dim totalRows As Long

    totalRows = ActiveCell.Row ' do NOT subtract one for the header

     HowManyRows = totalRows

End Function

Проходя в цикле каждый ряд мы будем создавать строку, которая берет значения отдельных столбцов и добавляет их в оператор SQL. Код приведен ниже:

Public Function getSQLForSingleRow(sheet As String, rowNumber As Long) As String  

    ' Не забудьте поменять форматирование, например, даты или числа

    fieldWithText = ReplaceSingleQuote(Worksheets(sheet).Range("A" & rowNumber).FormulaR1C1)

    fieldWithDate = Format(Worksheets(sheet).Range("B" & rowNumber).FormulaR1C1, "mm/dd/yyyy")

    fieldWithNumbers = CDbl(Nz(Worksheets(sheet).Range("C" & rowNumber).FormulaR1C1))    

    Dim strSQL As String 

    strSQL = " ("   

    strSQL = strSQL & " '" & fieldWithText & "',"

    strSQL = strSQL & " '" & fieldWithDate & "',"

    strSQL = strSQL & " " & fieldWithNumbers & "" ' Кавычки не нужны, т.к. это число

    strSQL = strSQL & " ) " 

    getSQLForSingleRow = strSQL 

End Function

Я имею две вспомогательные функции; одну для текста, а другую для чисел. Если значение представляет собой текст, нам нужно заменить ("экранировать") одиночную кавычку, для этого у меня есть такая функция:

Public Function ReplaceSingleQuote(str As String) As String

     If Len(Trim(str)) > 0 Then

        ReplaceSingleQuote = Replace(str, "'", "''")

    Else

        ReplaceSingleQuote = str

    End If

End Function

Я также создал функцию nz() (как "null-нуль", которая встроена в некоторые языки программирования), которая будет заменять числовые значения на "0", при необходимости:

Function Nz(value As String) As Double

    If IsNull(value) Or (value = "") Then

        Nz = 0

    Else

        Nz = value

    End If

End Function

Вот код, который проходит в цикле каждую строку электронной таблицы и генерирует оператор SQL:

Public Function ImportData(sheet As String)   

    Dim i As Integer   

    Dim strSQL As String

    Dim totalRows As Long   

    totalRows = HowManyRows(sheet)

    strInsertHeader = GetInsertHeader()        

    Dim strIndividualRows As String

    strIndividualRows = ""   

    For i = 2 To totalRows   

        strIndividualRows = strIndividualRows & getSQLForSingleRow(sheet, i)       

       ' добавить запятую в конце,

       ' которую удалим потом, если потребуется

       strIndividualRows = strIndividualRows & ","       

    Next   

    strSQL = strInsertHeader & " VALUES " & strIndividualRows

    strSQL = RemoveLastCharacterIfComma(strSQL)    

    Call RunSQL(strDbConn, strSQL)        

    Range("A1").Select

    MsgBox "Complete"

 End Function

Пошаговое объяснение:

• Вызываем функцию, которая передает имя электронной таблицы (лист) с данными, чтобы определить количество строк в наборе.


• Создаем переменную, которая содержит начало оператора SQL.


• Обходим в цикле каждую строку набора данных, создавая оператор INSERT...VALUES.


• В конце каждой строки данных добавляем запятую.


• Удаляем последнюю запятую в операторе.


• Выполняем SQL.

Я добавляю запятую в конце каждой ряда, а затем просто удаляю последнюю запятую в строке. Я использую следующую функцию:

Public Function RemoveLastCharacterIfComma(str As String) As String 

    str = Trim(str)   

    If Right(str, 1) = "," Then

        RemoveLastCharacterIfComma = Left(str, Len(str) - 1)

    Else

        RemoveLastCharacterIfComma = str

    End If    

End Function

Как обойти ограничение на импорт данных

Я столкнулся с тем, что при слишком длинных конкатенированных "значениях" Excel терпит крах. Выяснилось, что я должен ограничить скрипт импортирования до 500 строк одновременно.

Вот обновленный код:

Public Function ImportData(sheet As String)     

    Dim i As Long

    Dim strSQL As String

    Dim totalRows As Long   

    totalRows = HowManyRows(sheet)

    strInsertHeader = GetInsertHeader()    

    Dim strIndividualRows As String

    strIndividualRows = ""   

    For i = 2 To totalRows   

        strIndividualRows = strIndividualRows & getSQLForSingleRow(sheet, i)       

       ' add comma at the end no matter what; remove last one after

       strIndividualRows = strIndividualRows & ","      

       'Worksheets("Instructions").Range("I2").FormulaR1C1 = "Rows read in: " & i       

       ' вставлять в базу данных, пока не станет слишком большой

        If (i Mod 500) = 0 Then              

            strSQL = strInsertHeader & " VALUES " & strIndividualRows

            strSQL = RemoveLastCharacterIfComma(strSQL)           

            Call RunSQL(strDbConn, strSQL)

            strIndividualRows = ""           

            'Debug.Print "in the middle of importing " & i   

        End If       

    Next   

    ' вставить в последний пакет

    strSQL = strInsertHeader & " VALUES " & strIndividualRows

    strSQL = RemoveLastCharacterIfComma(strSQL)    

    Call RunSQL(strDbConn, strSQL)    

    strIndividualRows = ""

    'Debug.Print "last row " & i           

    Range("A1").Select 

    ' Complete: clear out the status

   ' Worksheets("Instructions").Range("I1").Formula2R1C1 = ""

   ' Worksheets("Instructions").Range("I2").Formula2R1C1 = ""    

    'MsgBox sheet + " data imported" 

End Function

Как можно увидеть, когда переменная, в которой хранится генерируемые значения, достигает 500 символов, в базу данных вставляются накопленные к тому времени данные. После завершения цикла вставляется оставшийся пакет.

Я оставил некоторый код закомментированным, который уведомляет пользователя о том, как движется процесс импорта.

В окончательном коде есть еще одна проверка для выполнения только последнего пакета кода при необходимости. Сейчас же, если вы пытаетесь импортировать количество строк, кратное 500, вы получите сообщение об ошибке.

Собираем все вместе

Чтобы сделать это более полезным, нам может понадобиться удалять существующие данные.

Хотя вы можете получить «дату последнего обновления» из набора данных, этот пример кода демонстрирует дополнительный оператор SQL для выполнения запроса UPDATE с целью указания даты импорта.

Я создал процедуру с именем autoImport, которая выполняет:

• Удаляет существующие данные.


• Вызывает функцию, которая импортирует данные.


• Выполняет запрос UPDATE для указания даты обновления данных.

Public Sub autoImport()

    ' Сначала удаляем существующие данные

    Dim strSQL As String

    strSQL = "DELETE FROM myTableName" ' Альтернативно можно использовать TRUNCATE

    Call RunSQL(strDbConn, strSQL)   

    ' Импорт новых данных

    Call ImportData("tabWithData") ' Убедитесь, что передали имя листа, или получите его динамически

    ' Указываем, когда данные обновлялись; я использую таблицу "utility"

    Dim theDate As String

    theDate = InputBox("Enter date that the data for", "Data as of", Format(Now, "m/d/yyyy"))

    strSQL = "UPDATE Utility SET value = '" & ReplaceSingleQuote(theDate) & "' WHERE description IN ('Last Updated,'Last Updated')"

    Call RunSQL(strDbConn, strSQL)        

    Range("A1").Select    

    MsgBox "Data has been imported"

End Sub

Весь код
Посмотреть полный код.