Sub ЗагрузитьБалансВнешняяАналитика()
Лист1.Select
Call Загрузка_таблицы_на_сервер(False, True)
End Sub
Sub Загрузка_таблицы_на_сервер(Optional trunc As Boolean = False, Optional IsMSSQL As Boolean = True)
With Application: .ScreenUpdating = True: .DisplayAlerts = False: .Calculation = xlCalculationManual: End With
Dim time As Date: time = Now()
Dim a As Long, b As Long, sh_num As Long
Dim fact_list_row As Byte: fact_list_row = 2 'строка с заголовком
Dim format_row As Byte: format_row = 3 'строка с фактом
Dim sql As String, sql_val As String, sql_table As String, fld As String
Dim f_text As String, f_number As Double, f_number_s As String, f_date As Date 'значения
Dim fld_all As String
Dim ASY As Variant, send As Boolean
Dim tbl As String: tbl = ActiveSheet.Name
'создаем соединения
Dim ASY1 As New async, ASY2 As New async, ASY3 As New async, ASY4 As New async, ASY5 As New async, ASY6 As New async, ASY7 As New async, ASY8 As New async
a = 0
For Each ASY In Array(ASY1, ASY2, ASY3, ASY4, ASY5, ASY6, ASY7, ASY8)
a = a + 1
ASY.Connect
ASY.ID = a
While ASY.Connection.State = 2: Wend 'ждем готовности всех соединений
Next ASY
tbl = ActiveSheet.Name
'чистим таблицу на сервере ORACLE
' If trunc Then
' sql = "truncate table " & tbl & ""
' ASY1.Query (sql)
' ASY1.ConnectComplete
'End If
Dim cnt_str As Integer
cnt_str = ActiveSheet.Cells(2, 1).End(xlToRight).Column
'собираем поля
fld_all = vbNullString
For a = 1 To cnt_str
fld_all = fld_all & ActiveSheet.Cells(2, a) & ","
Next a
fld_all = Left(fld_all, Len(fld_all) - 1)
Dim c As Long
For a = 3 To ActiveSheet.Cells(2, 1).End(xlDown).Row
'If a = 401 Then MsgBox 1
DoEvents
sql_val = ""
sql_val = ""
For b = 1 To 1 + cnt_str
fld = "": fld = ActiveSheet.Cells(2, b).Value
If IsMSSQL Then
Select Case ActiveSheet.Cells(1, b).Value
Case "t": f_text = ActiveSheet.Cells(a, b).Value: sql_val = sql_val & "'" & f_text & "' " & fld & ","
Case "n": f_number_s = Replace(CStr(ActiveSheet.Cells(a, b).Value), "'", ""): sql_val = sql_val & "cast(replace('" & f_number_s & "',',','.') as float) " & fld & ","
Case "d": f_date = ActiveSheet.Cells(a, b).Value: sql_val = sql_val & "{ d '" & Format(f_date, "yyyy-mm-dd") & "'} " & fld & ","
End Select
Else 'ORACLE
Select Case ActiveSheet.Cells(1, b).Value
Case "t": f_text = Replace(ActiveSheet.Cells(a, b).Value, "'", ""): sql_val = sql_val & "'" & f_text & "' " & fld & ","
Case "n": f_number = ActiveSheet.Cells(a, b).Value: f_number_s = CStr(f_number): sql_val = sql_val & "cast(replace('" & f_number_s & "',',','.') as float) " & fld & ","
Case "d": f_date = ActiveSheet.Cells(a, b).Value: sql_val = sql_val & "to_date('" & Format(f_date, "dd.mm.yyyy hh:mm:ss") & "','DD.MM.YYYY HH24:MI:SS') " & fld & ","
End Select
End If
Next b
'добавляем юнион
If IsMSSQL Then
sql_val = Left(sql_val, Len(sql_val) - 1) & " " & vbNewLine & " Union all " & vbNewLine
Else 'ORACLE
sql_val = Left(sql_val, Len(sql_val) - 1) & " from dual" & vbNewLine & " Union all " & vbNewLine
End If
sql_table = sql_table & "Select " & sql_val
'и как мы набрали достаточное кол-во строчек, отправляем данные на сервер
If a Mod 200 = 0 Then
If Not sql_table = "" Then
sql_table = Left(sql_table, Len(sql_table) - 12)
sql = "insert into " & tbl & " (" & fld_all & ") select * from (" & sql_table & ") a"
restart_send:
send = False
For Each ASY In Array(ASY1, ASY2, ASY3, ASY4, ASY5, ASY6, ASY7, ASY8)
If ASY.Connection.State = 1 Then
Debug.Print "Запрос отправлен в канал: " & ASY.ID
Application.StatusBar = "Лист: " & 1 & " из " & 1 & ".Строка: " & a & " из " & ActiveSheet.UsedRange.Rows.Count
'Debug.Print sql
ASY.Query sql: send = True: Exit For
Else
Debug.Print "Канал " & ASY.ID & " занят."
End If
Next ASY
If send = False Then
Debug.Print "Все соединения заняты, ожидаю: " & TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 5)
Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 2)
GoTo restart_send
End If
sql_table = ""
End If
End If
Next a
If Not sql_table = "" Then
sql_table = Left(sql_table, Len(sql_table) - 12)
sql = "insert into " & tbl & " (" & fld_all & ") select * from (" & sql_table & ") a"
'MsgBox sql
ASY1.Query (sql)
sql_table = ""
ASY1.ConnectComplete
End If
With Application: .StatusBar = False: .DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True: End With
Debug.Print "Загрузка завершена"
End Sub
|