'==============================================================================
' МОДУЛЬ: DataLoader_Main
' Файл: DataLoader.xlsm
' Описание: Центральный загрузчик для множества файлов Excel -> SQL Server
' Дата: 2024-11-10
'==============================================================================

Option Explicit

' ===============================================================================
' КОНСТАНТЫ
' ===============================================================================

Public Const CONFIG_SHEET As String = "Config"
Public Const LOG_SHEET As String = "Log"

' ===============================================================================
' ТИПЫ ДАННЫХ
' ===============================================================================

Public Type FileConfig
FileNumber As Long
TableName As String
FilePath As String
SheetName As String
LoadFlag As Boolean
ClearTable As Boolean
AutoCreate As Boolean
BatchSize As Long
LastRow As Long
LastCol As Long
Status As String
ErrorMessage As String
End Type

' ===============================================================================
' ГЛАВНАЯ ПРОЦЕДУРА
' ===============================================================================

Sub Load_All_Files_To_SQL()
'==============================================================================
' Главная процедура: загружает все файлы с индивидуальными настройками
'==============================================================================
Dim configWs As Worksheet
Dim logWs As Worksheet
Dim conn As Object
Dim files() As FileConfig
Dim fileCount As Long
Dim i As Long
Dim startTime As Double
Dim elapsedTime As Double
Dim totalRows As Long
Dim successCount As Long
Dim errorCount As Long

' Параметры подключения
Dim sqlServer As String
Dim sqlDatabase As String
Dim windowsAuth As Boolean
Dim sqlLogin As String
Dim sqlPassword As String

' Глобальные параметры
Dim detailedLog As Boolean
Dim connectionTimeout As Long
Dim commandTimeout As Long

On Error GoTo ErrorHandler

startTime = Timer

' ===============================================================================
' ШАГ 1: ПОЛУЧАЕМ ЛИСТЫ
' ===============================================================================
On Error Resume Next
Set configWs = ThisWorkbook.Worksheets(CONFIG_SHEET)
Set logWs = ThisWorkbook.Worksheets(LOG_SHEET)
On Error GoTo ErrorHandler

If configWs Is Nothing Then
MsgBox "ОШИБКА: Не найден лист 'Config'!", vbCritical
Exit Sub
End If

' ===============================================================================
' ШАГ 2: ЧИТАЕМ НАСТРОЙКИ ПОДКЛЮЧЕНИЯ
' ===============================================================================
sqlServer = Trim(configWs.Range("B19").Value)
sqlDatabase = Trim(configWs.Range("B20").Value)
windowsAuth = ReadBooleanValue(configWs.Range("B21").Value)
sqlLogin = Trim(configWs.Range("B22").Value)
sqlPassword = Trim(configWs.Range("B23").Value)

' Валидация
If sqlServer = "" Or sqlDatabase = "" Then
MsgBox "ОШИБКА: Заполните настройки подключения!" & vbCrLf & vbCrLf & _
"SQL Server (B19) и Database (B20) обязательны!", vbCritical
Exit Sub
End If

If Not windowsAuth And (sqlLogin = "" Or sqlPassword = "") Then
MsgBox "ОШИБКА: Для SQL Authentication укажите Login и Password!", vbCritical
Exit Sub
End If

' ===============================================================================
' ШАГ 3: ЧИТАЕМ ГЛОБАЛЬНЫЕ ПАРАМЕТРЫ
' ===============================================================================
detailedLog = ReadBooleanValue(configWs.Range("B29").Value)
connectionTimeout = ReadNumericValue(configWs.Range("B30").Value, 30)
commandTimeout = ReadNumericValue(configWs.Range("B31").Value, 1800)

' ===============================================================================
' ШАГ 4: ЧИТАЕМ СПИСОК ФАЙЛОВ С ИНДИВИДУАЛЬНЫМИ НАСТРОЙКАМИ
' ===============================================================================
files = ReadFileConfigs(configWs, fileCount)

If fileCount = 0 Then
MsgBox "ОШИБКА: Нет файлов для загрузки!" & vbCrLf & vbCrLf & _
"Установите TRUE в столбце E для нужных файлов.", vbInformation
Exit Sub
End If

' ===============================================================================
' ШАГ 5: ФОРМИРУЕМ СВОДКУ ДЛЯ ПОДТВЕРЖДЕНИЯ
' ===============================================================================
Dim summaryMsg As String
summaryMsg = "МАССОВАЯ ЗАГРУЗКА ФАЙЛОВ В SQL SERVER" & vbCrLf & vbCrLf & _
"=======================================================" & vbCrLf & _
"ПОДКЛЮЧЕНИЕ:" & vbCrLf & _
"=======================================================" & vbCrLf & _
"SQL Server: " & sqlServer & vbCrLf & _
"Database: " & sqlDatabase & vbCrLf & _
"Auth: " & IIf(windowsAuth, "Windows", "SQL Login") & vbCrLf & vbCrLf & _
"=======================================================" & vbCrLf & _
"ФАЙЛЫ К ЗАГРУЗКЕ: " & fileCount & vbCrLf & _
"=======================================================" & vbCrLf

' Добавляем информацию о каждом файле
For i = 1 To Application.Min(fileCount, 5)
summaryMsg = summaryMsg & _
i & ". " & files(i).TableName & vbCrLf & _
" Очистка: " & IIf(files(i).ClearTable, "ДА", "НЕТ") & _
" | Создать: " & IIf(files(i).AutoCreate, "ДА", "НЕТ") & _
" | Пакет: " & files(i).BatchSize & vbCrLf
Next i

If fileCount > 5 Then
summaryMsg = summaryMsg & " ... и ещё " & (fileCount - 5) & " файлов" & vbCrLf
End If

summaryMsg = summaryMsg & vbCrLf & "Продолжить?"

If MsgBox(summaryMsg, vbYesNo + vbQuestion, "Подтверждение") = vbNo Then
Exit Sub
End If

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

' ===============================================================================
' ШАГ 6: ПОДКЛЮЧАЕМСЯ К SQL SERVER
' ===============================================================================
Application.StatusBar = "Подключение к SQL Server..."

Set conn = CreateObject("ADODB.Connection")
conn.ConnectionTimeout = connectionTimeout
conn.CommandTimeout = commandTimeout
conn.Open BuildConnectionString(sqlServer, sqlDatabase, windowsAuth, sqlLogin, sqlPassword)

LogMessage logWs, "OK Подключение установлено: " & sqlServer & "\" & sqlDatabase, detailedLog

' ===============================================================================
' ШАГ 7: ИНИЦИАЛИЗАЦИЯ ЛОГА
' ===============================================================================
If Not logWs Is Nothing Then
ClearLog logWs
LogMessage logWs, "============================================================", True
LogMessage logWs, " МАССОВАЯ ЗАГРУЗКА ДАННЫХ В SQL SERVER", True
LogMessage logWs, " Начало: " & Format(Now, "yyyy-mm-dd hh:mm:ss"), True
LogMessage logWs, " Файлов к загрузке: " & fileCount, True
LogMessage logWs, "============================================================", True
LogMessage logWs, "", True
End If

' ===============================================================================
' ШАГ 8: ГЛАВНЫЙ ЦИКЛ - ОБРАБОТКА КАЖДОГО ФАЙЛА
' ===============================================================================
successCount = 0
errorCount = 0
totalRows = 0

For i = 1 To fileCount
Application.StatusBar = "Файл " & i & "/" & fileCount & ": " & files(i).TableName

LogMessage logWs, "------------------------------------------------------------", detailedLog
LogMessage logWs, "> Файл " & i & "/" & fileCount, True
LogMessage logWs, " Таблица: " & files(i).TableName, True
LogMessage logWs, " Файл: " & files(i).FilePath, detailedLog
LogMessage logWs, " Параметры: Очистка=" & IIf(files(i).ClearTable, "ДА", "НЕТ") & _
" | Автосоздание=" & IIf(files(i).AutoCreate, "ДА", "НЕТ") & _
" | Пакет=" & files(i).BatchSize, detailedLog

' Обрабатываем файл с его индивидуальными настройками
If ProcessSingleFile(conn, files(i), logWs, detailedLog) Then
successCount = successCount + 1
totalRows = totalRows + files(i).LastRow - 1
files(i).Status = "OK Успешно"
LogMessage logWs, " OK Загружено строк: " & Format(files(i).LastRow - 1, "#,##0"), True
Else
errorCount = errorCount + 1
files(i).Status = "ОШИБКА"
LogMessage logWs, " ОШИБКА: " & files(i).ErrorMessage, True
End If

' Обновляем статус в Config (столбец I - статус)
Dim configRow As Long
configRow = 1 + i
configWs.Cells(configRow, 9).Value = files(i).Status
If files(i).ErrorMessage <> "" Then
configWs.Cells(configRow, 10).Value = files(i).ErrorMessage
End If

DoEvents
Next i

' ===============================================================================
' ШАГ 9: ЗАКРЫВАЕМ СОЕДИНЕНИЕ
' ===============================================================================
conn.Close
Set conn = Nothing

Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

elapsedTime = (Timer - startTime) / 60

' ===============================================================================
' ШАГ 10: ИТОГОВЫЙ ЛОГ
' ===============================================================================
LogMessage logWs, "", True
LogMessage logWs, "============================================================", True
LogMessage logWs, " ЗАГРУЗКА ЗАВЕРШЕНА", True
LogMessage logWs, " Окончание: " & Format(Now, "yyyy-mm-dd hh:mm:ss"), True
LogMessage logWs, "------------------------------------------------------------", True
LogMessage logWs, " OK Успешно: " & successCount & " из " & fileCount & " файлов", True
LogMessage logWs, " ОШИБКА: " & errorCount & " файлов", True
LogMessage logWs, " Всего строк: " & Format(totalRows, "#,##0"), True
LogMessage logWs, " Время: " & Format(elapsedTime, "0.00") & " мин", True

If totalRows > 0 And elapsedTime > 0 Then
LogMessage logWs, " Скорость: " & Format(totalRows / elapsedTime, "#,##0") & " строк/мин", True
End If

LogMessage logWs, "============================================================", True

' ===============================================================================
' ШАГ 11: ИТОГОВОЕ СООБЩЕНИЕ
' ===============================================================================
MsgBox "МАССОВАЯ ЗАГРУЗКА ЗАВЕРШЕНА!" & vbCrLf & vbCrLf & _
"=======================================" & vbCrLf & _
"OK Успешно: " & successCount & " из " & fileCount & " файлов" & vbCrLf & _
"ОШИБКА: " & errorCount & " файлов" & vbCrLf & _
"Всего строк: " & Format(totalRows, "#,##0") & vbCrLf & _
"Время: " & Format(elapsedTime, "0.00") & " мин" & vbCrLf & vbCrLf & _
IIf(totalRows > 0, "Скорость: " & Format(totalRows / elapsedTime, "#,##0") & " строк/мин" & vbCrLf & vbCrLf, "") & _
"Подробности на листе '" & LOG_SHEET & "'", _
IIf(errorCount = 0, vbInformation, vbExclamation), _
"Результат загрузки"

Exit Sub

ErrorHandler:
Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

If Not conn Is Nothing Then
If conn.State = 1 Then conn.Close
End If

MsgBox "КРИТИЧЕСКАЯ ОШИБКА:" & vbCrLf & vbCrLf & Err.Description, vbCritical
LogMessage logWs, "КРИТИЧЕСКАЯ ОШИБКА: " & Err.Description, True
End Sub

' ===============================================================================
' ВСПОМОГАТЕЛЬНЫЕ ФУНКЦИИ
' ===============================================================================

Function ReadFileConfigs(configWs As Worksheet, ByRef fileCount As Long) As FileConfig()
'==============================================================================
' Читает конфигурацию файлов с индивидуальными настройками
'==============================================================================
Dim tempFiles() As FileConfig
Dim lastRow As Long
Dim i As Long
Dim count As Long
Dim loadFlag As Boolean

lastRow = configWs.Cells(configWs.Rows.count, 2).End(xlUp).Row

If lastRow < 2 Then
fileCount = 0
Exit Function
End If

ReDim tempFiles(1 To lastRow - 1)
count = 0

For i = 2 To lastRow
loadFlag = ReadBooleanValue(configWs.Cells(i, 5).Value)

If loadFlag Then
count = count + 1

With tempFiles(count)
.FileNumber = configWs.Cells(i, 1).Value
.TableName = Trim(configWs.Cells(i, 2).Value)
.FilePath = Trim(configWs.Cells(i, 3).Value)
.SheetName = Trim(configWs.Cells(i, 4).Value)
.LoadFlag = True
.ClearTable = ReadBooleanValue(configWs.Cells(i, 6).Value)
.AutoCreate = ReadBooleanValue(configWs.Cells(i, 7).Value)
.BatchSize = ReadNumericValue(configWs.Cells(i, 8).Value, 500)
.Status = "В очереди"
.ErrorMessage = ""
End With

If tempFiles(count).TableName = "" Or tempFiles(count).FilePath = "" Then
MsgBox "ВНИМАНИЕ: Строка " & i & ": не заполнены обязательные поля", vbExclamation
count = count - 1
ElseIf Not FileExists(tempFiles(count).FilePath) Then
MsgBox "ВНИМАНИЕ: Строка " & i & ": файл не найден" & vbCrLf & tempFiles(count).FilePath, vbExclamation
count = count - 1
End If
End If
Next i

fileCount = count

If count > 0 Then
ReDim Preserve tempFiles(1 To count)
End If

ReadFileConfigs = tempFiles
End Function

Function ProcessSingleFile(conn As Object, ByRef fileConfig As FileConfig, _
logWs As Worksheet, detailedLog As Boolean) As Boolean
'==============================================================================
' Обрабатывает один файл с его индивидуальными настройками
'==============================================================================
Dim sourceWb As Workbook
Dim sourceWs As Worksheet
Dim lastRow As Long, lastCol As Long
Dim dataArray As Variant
Dim tableExists As Boolean

On Error GoTo ProcessError

Application.StatusBar = "Открытие: " & fileConfig.FilePath
Set sourceWb = Workbooks.Open(fileConfig.FilePath, ReadOnly:=True, UpdateLinks:=False)

If fileConfig.SheetName = "" Then
Set sourceWs = sourceWb.Worksheets(1)
fileConfig.SheetName = sourceWs.Name
Else
Set sourceWs = sourceWb.Worksheets(fileConfig.SheetName)
End If

LogMessage logWs, " Лист: " & fileConfig.SheetName, detailedLog

lastRow = sourceWs.Cells(sourceWs.Rows.count, 1).End(xlUp).Row
lastCol = sourceWs.Cells(1, sourceWs.Columns.count).End(xlToLeft).Column

fileConfig.LastRow = lastRow
fileConfig.LastCol = lastCol

LogMessage logWs, " Данные: " & Format(lastRow - 1, "#,##0") & " строк x " & lastCol & " столбцов", detailedLog

If lastRow < 2 Then
fileConfig.ErrorMessage = "Нет данных"
LogMessage logWs, " ВНИМАНИЕ: Нет данных", True
sourceWb.Close SaveChanges:=False
ProcessSingleFile = False
Exit Function
End If

tableExists = TableExists(conn, fileConfig.TableName)

If Not tableExists And fileConfig.AutoCreate Then
LogMessage logWs, " Создание таблицы...", detailedLog
If Not CreateTableFromWorksheet(conn, sourceWs, fileConfig.TableName, lastRow, lastCol, logWs, detailedLog) Then
fileConfig.ErrorMessage = "Ошибка создания таблицы"
sourceWb.Close SaveChanges:=False
ProcessSingleFile = False
Exit Function
End If
LogMessage logWs, " OK Таблица создана", detailedLog
ElseIf Not tableExists Then
fileConfig.ErrorMessage = "Таблица не существует"
LogMessage logWs, " ОШИБКА: Таблица не существует (автосоздание отключено)", True
sourceWb.Close SaveChanges:=False
ProcessSingleFile = False
Exit Function
End If

If fileConfig.ClearTable Then
LogMessage logWs, " Очистка таблицы...", detailedLog
ClearTableSafe conn, fileConfig.TableName
LogMessage logWs, " OK Таблица очищена", detailedLog
End If

Application.StatusBar = "Чтение: " & fileConfig.TableName
dataArray = sourceWs.Range(sourceWs.Cells(2, 1), sourceWs.Cells(lastRow, lastCol)).Value

sourceWb.Close SaveChanges:=False
Set sourceWb = Nothing

LogMessage logWs, " OK Данные прочитаны в память", detailedLog
LogMessage logWs, " Загрузка данных (пакеты по " & fileConfig.BatchSize & " строк)...", detailedLog

If LoadDataFromArray(conn, fileConfig.TableName, dataArray, lastCol, fileConfig.BatchSize, logWs, detailedLog) Then
ProcessSingleFile = True
Else
fileConfig.ErrorMessage = "Ошибка загрузки данных"
ProcessSingleFile = False
End If

Exit Function

ProcessError:
fileConfig.ErrorMessage = Err.Description
LogMessage logWs, " ОШИБКА: " & Err.Description, True

If Not sourceWb Is Nothing Then
On Error Resume Next
sourceWb.Close SaveChanges:=False
On Error GoTo 0
End If

ProcessSingleFile = False
End Function

Function LoadDataFromArray(conn As Object, tableName As String, dataArray As Variant, _
colCount As Long, batchSize As Long, _
logWs As Worksheet, detailedLog As Boolean) As Boolean
'==============================================================================
' Загружает данные с указанным размером пакета
'==============================================================================
Dim rowCount As Long
Dim currentRow As Long
Dim batchEnd As Long
Dim insertedRows As Long
Dim batchCount As Long
Dim totalBatches As Long

On Error GoTo LoadError

rowCount = UBound(dataArray, 1)
totalBatches = Application.WorksheetFunction.RoundUp(rowCount / batchSize, 0)
insertedRows = 0
batchCount = 0

LogMessage logWs, " Всего пакетов: " & totalBatches, detailedLog

currentRow = 1
Do While currentRow <= rowCount
batchEnd = Application.Min(currentRow + batchSize - 1, rowCount)
batchCount = batchCount + 1

If InsertBatchFromArray(conn, tableName, dataArray, currentRow, batchEnd, colCount) Then
insertedRows = insertedRows + (batchEnd - currentRow + 1)
Else
LogMessage logWs, " ВНИМАНИЕ: Ошибка в пакете " & batchCount, detailedLog
End If

currentRow = batchEnd + 1

If batchCount Mod 20 = 0 Then
Application.StatusBar = "Загружено: " & Format(insertedRows, "#,##0") & "/" & Format(rowCount, "#,##0")
LogMessage logWs, " Прогресс: " & batchCount & "/" & totalBatches & " пакетов (" & _
Format(insertedRows, "#,##0") & " строк)", detailedLog
DoEvents
End If
Loop

LoadDataFromArray = (insertedRows > 0)
Exit Function

LoadError:
LogMessage logWs, " ОШИБКА загрузки: " & Err.Description, True
LoadDataFromArray = False
End Function

Function ReadBooleanValue(cellValue As Variant) As Boolean
Dim strValue As String

If IsEmpty(cellValue) Or IsNull(cellValue) Then
ReadBooleanValue = False
Exit Function
End If

If VarType(cellValue) = vbBoolean Then
ReadBooleanValue = cellValue
Exit Function
End If

strValue = UCase(Trim(CStr(cellValue)))

Select Case strValue
Case "TRUE", "1", "ДА", "YES", "Y", "T"
ReadBooleanValue = True
Case Else
ReadBooleanValue = False
End Select
End Function

Function ReadNumericValue(cellValue As Variant, defaultValue As Long) As Long
If IsEmpty(cellValue) Or Not IsNumeric(cellValue) Then
ReadNumericValue = defaultValue
Else
ReadNumericValue = CLng(cellValue)
If ReadNumericValue < 10 Then ReadNumericValue = 10
If ReadNumericValue > 5000 Then ReadNumericValue = 5000
End If
End Function

Function BuildConnectionString(server As String, database As String, _
windowsAuth As Boolean, _
Optional sqlLogin As String = "", _
Optional sqlPassword As String = "") As String
Dim connStr As String

connStr = "Provider=SQLOLEDB;"
connStr = connStr & "Data Source=" & server & ";"
connStr = connStr & "Initial Catalog=" & database & ";"

If windowsAuth Then
connStr = connStr & "Integrated Security=SSPI;"
Else
connStr = connStr & "User ID=" & sqlLogin & ";"
connStr = connStr & "Password=" & sqlPassword & ";"
End If

BuildConnectionString = connStr
End Function

Sub LogMessage(logWs As Worksheet, message As String, writeLog As Boolean)
If Not logWs Is Nothing And writeLog Then
Dim lastRow As Long
lastRow = logWs.Cells(logWs.Rows.count, 1).End(xlUp).Row + 1
logWs.Cells(lastRow, 1).Value = Format(Now, "yyyy-mm-dd hh:mm:ss")
logWs.Cells(lastRow, 2).Value = message
End If

Debug.Print message
End Sub

Sub ClearLog(logWs As Worksheet)
If Not logWs Is Nothing Then
logWs.Cells.Clear
logWs.Cells(1, 1).Value = "Время"
logWs.Cells(1, 2).Value = "Сообщение"
logWs.Rows(1).Font.Bold = True
End If
End Sub




'==============================================================================
' МОДУЛЬ: DataLoader_Helpers
' Вспомогательные функции для загрузки данных
' Дата: 2024-11-10
'==============================================================================

Option Explicit

' ===============================================================================
' ТИПЫ ДАННЫХ (ОБЪЯВЛЯЕМ В САМОМ НАЧАЛЕ!)
' ===============================================================================

Type ColumnAnalysis
HeaderName As String
SQLName As String
DataType As String
MaxLength As Long
HasNulls As Boolean
End Type

' ===============================================================================
' ФУНКЦИИ
' ===============================================================================

Function TableExists(conn As Object, tableName As String) As Boolean
'==============================================================================
' Проверяет существование таблицы в SQL Server
'==============================================================================
Dim rs As Object
Dim sql As String

On Error Resume Next
sql = "SELECT 1 FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_NAME = '" & tableName & "'"
Set rs = conn.Execute(sql)

If Not rs Is Nothing Then
TableExists = Not rs.EOF
rs.Close
Else
TableExists = False
End If

Set rs = Nothing
On Error GoTo 0
End Function

Function FileExists(filePath As String) As Boolean
'==============================================================================
' Проверяет существование файла
'==============================================================================
On Error Resume Next
FileExists = (Dir(filePath) <> "")
On Error GoTo 0
End Function

Function CreateTableFromWorksheet(conn As Object, ws As Worksheet, tableName As String, _
lastRow As Long, lastCol As Long, _
logWs As Worksheet, detailedLog As Boolean) As Boolean
'==============================================================================
' Создает таблицу SQL на основе структуры листа Excel
'==============================================================================
Dim columnInfo() As ColumnAnalysis
Dim createSQL As String
Dim i As Long

On Error GoTo CreateError

ReDim columnInfo(1 To lastCol)

For i = 1 To lastCol
columnInfo(i) = AnalyzeColumnFast(ws, i, Application.Min(lastRow, 1000))
Next i

createSQL = GenerateCreateTableSQL(tableName, columnInfo, lastCol)

On Error Resume Next
conn.Execute "DROP TABLE [dbo].[" & tableName & "]"
On Error GoTo CreateError

conn.Execute createSQL

CreateTableFromWorksheet = True
Exit Function

CreateError:
LogMessage logWs, " ОШИБКА создания таблицы: " & Err.Description, True
CreateTableFromWorksheet = False
End Function

Function AnalyzeColumnFast(ws As Worksheet, colIndex As Long, maxRows As Long) As ColumnAnalysis
'==============================================================================
' Быстрый анализ столбца (первые N строк)
'==============================================================================
Dim result As ColumnAnalysis
Dim i As Long
Dim cellValue As Variant
Dim isNumeric As Boolean, isDate As Boolean
Dim maxLen As Long

With result
.HeaderName = Trim(CStr(ws.Cells(1, colIndex).Value))
If .HeaderName = "" Then .HeaderName = "Column_" & colIndex
.SQLName = MakeSQLSafe(.HeaderName)
.MaxLength = 0
.HasNulls = False
isNumeric = True
isDate = True
maxLen = 0
End With

For i = 2 To maxRows
cellValue = ws.Cells(i, colIndex).Value

If IsEmpty(cellValue) Or IsNull(cellValue) Or Trim(CStr(cellValue)) = "" Then
result.HasNulls = True
GoTo NextRow
End If

If isDate And Not IsDate(cellValue) Then isDate = False
If isNumeric And Not VBA.IsNumeric(cellValue) Then isNumeric = False

Dim strLen As Long
strLen = Len(CStr(cellValue))
If strLen > maxLen Then maxLen = strLen

NextRow:
Next i

If isDate And Not isNumeric Then
result.DataType = "DATETIME"
ElseIf isNumeric And Not isDate Then
result.DataType = "DECIMAL(18,4)"
Else
result.MaxLength = Application.Max(50, maxLen * 1.3)
If result.MaxLength > 4000 Then
result.DataType = "NVARCHAR(MAX)"
Else
result.DataType = "NVARCHAR(" & result.MaxLength & ")"
End If
End If

AnalyzeColumnFast = result
End Function

Function GenerateCreateTableSQL(tableName As String, columnInfo() As ColumnAnalysis, colCount As Long) As String
'==============================================================================
' Формирует CREATE TABLE SQL
'==============================================================================
Dim sql As String
Dim i As Long

sql = "CREATE TABLE [dbo].[" & tableName & "] (" & vbCrLf
sql = sql & " [RowID] BIGINT IDENTITY(1,1) PRIMARY KEY," & vbCrLf
sql = sql & " [LoadDate] DATETIME DEFAULT GETDATE()," & vbCrLf

For i = 1 To colCount
sql = sql & " [" & columnInfo(i).SQLName & "] " & columnInfo(i).DataType & " NULL"
If i < colCount Then sql = sql & ","
sql = sql & vbCrLf
Next i

sql = sql & ");"

GenerateCreateTableSQL = sql
End Function

Function MakeSQLSafe(inputText As String) As String
'==============================================================================
' Делает строку безопасной для SQL (имя столбца)
'==============================================================================
Dim result As String
Dim i As Long
Dim char As String

result = ""
For i = 1 To Len(inputText)
char = Mid(inputText, i, 1)
If char Like "[A-Za-zА-Яа-я0-9_]" Then
result = result & char
ElseIf char = " " Then
result = result & "_"
End If
Next i

If Left(result, 1) Like "[0-9]" Then result = "Col_" & result
If result = "" Then result = "Column"

MakeSQLSafe = result
End Function

Sub ClearTableSafe(conn As Object, tableName As String)
'==============================================================================
' Безопасная очистка таблицы
'==============================================================================
On Error Resume Next
conn.Execute "TRUNCATE TABLE [dbo].[" & tableName & "]"

If Err.Number <> 0 Then
Err.Clear
conn.Execute "DELETE FROM [dbo].[" & tableName & "]"
End If

On Error GoTo 0
End Sub

Function InsertBatchFromArray(conn As Object, tableName As String, _
dataArray As Variant, startRow As Long, _
endRow As Long, colCount As Long) As Boolean
'==============================================================================
' Вставляет пакет данных из массива
'==============================================================================
Dim insertSQL As String
Dim valuesSQL As String
Dim i As Long, j As Long
Dim cellValue As Variant
Dim attempt As Long

On Error GoTo BatchError

insertSQL = "INSERT INTO [dbo].[" & tableName & "] VALUES "
valuesSQL = ""

For i = startRow To endRow
If i > startRow Then valuesSQL = valuesSQL & ","
valuesSQL = valuesSQL & vbCrLf & "("

For j = 1 To colCount
If j > 1 Then valuesSQL = valuesSQL & ","
cellValue = dataArray(i, j)
valuesSQL = valuesSQL & FormatSQLValue(cellValue)
Next j

valuesSQL = valuesSQL & ")"
Next i

insertSQL = insertSQL & valuesSQL

For attempt = 1 To 3
On Error Resume Next
Err.Clear
conn.Execute insertSQL

If Err.Number = 0 Then
InsertBatchFromArray = True
Exit Function
Else
If attempt < 3 Then Application.Wait Now + TimeValue("00:00:01")
End If
On Error GoTo BatchError
Next attempt

InsertBatchFromArray = False
Exit Function

BatchError:
InsertBatchFromArray = False
End Function

Function FormatSQLValue(value As Variant) As String
'==============================================================================
' Форматирует значение для SQL (защита от SQL Injection)
'==============================================================================
If IsNull(value) Or IsEmpty(value) Or Trim(CStr(value)) = "" Then
FormatSQLValue = "NULL"
ElseIf IsDate(value) Then
FormatSQLValue = "'" & Format(value, "yyyy-mm-dd hh:mm:ss") & "'"
ElseIf VBA.IsNumeric(value) Then
FormatSQLValue = Replace(CStr(value), ",", ".")
Else
Dim strValue As String
strValue = CStr(value)
strValue = Replace(strValue, "'", "''")
If Len(strValue) > 8000 Then strValue = Left(strValue, 8000)
FormatSQLValue = "N'" & strValue & "'"
End If
End Function