Attribute VB_Name = "ToyWorldDb"
Option Explicit

' Тема "игрушки": схема БД зашита, данные берутся из листов книги.
' Листы определяются по заголовкам: товары / пользователи / заказы / пункты выдачи.
' Результат -> generated.sql рядом с книгой. Запуск: Alt+F8 -> GenerateToyDb.

Private buf As String

Public Sub GenerateToyDb()
    buf = ""
    Emit SchemaSql()
    SeedSql
    Emit ViewsSql()
    WriteUtf8 ActiveWorkbook.Path & "\generated.sql", buf
    MsgBox "Готово:" & vbCrLf & ActiveWorkbook.Path & "\generated.sql", vbInformation
End Sub

Private Sub Emit(ByVal s As String)
    buf = buf & s & vbCrLf
End Sub

Private Function SchemaSql() As String
    Dim s As String
    s = "IF DB_ID('ToyWorldDb') IS NULL CREATE DATABASE ToyWorldDb;" & vbCrLf & "GO" & vbCrLf
    s = s & "USE ToyWorldDb;" & vbCrLf & "GO" & vbCrLf
    s = s & "IF OBJECT_ID('dbo.OrderItem','U') IS NOT NULL DROP TABLE dbo.OrderItem;" & vbCrLf
    s = s & "IF OBJECT_ID('dbo.[Order]','U') IS NOT NULL DROP TABLE dbo.[Order];" & vbCrLf
    s = s & "IF OBJECT_ID('dbo.Product','U') IS NOT NULL DROP TABLE dbo.Product;" & vbCrLf
    s = s & "IF OBJECT_ID('dbo.[User]','U') IS NOT NULL DROP TABLE dbo.[User];" & vbCrLf
    s = s & "IF OBJECT_ID('dbo.PickupPoint','U') IS NOT NULL DROP TABLE dbo.PickupPoint;" & vbCrLf
    s = s & "IF OBJECT_ID('dbo.OrderStatus','U') IS NOT NULL DROP TABLE dbo.OrderStatus;" & vbCrLf
    s = s & "IF OBJECT_ID('dbo.Category','U') IS NOT NULL DROP TABLE dbo.Category;" & vbCrLf
    s = s & "IF OBJECT_ID('dbo.Manufacturer','U') IS NOT NULL DROP TABLE dbo.Manufacturer;" & vbCrLf
    s = s & "IF OBJECT_ID('dbo.Supplier','U') IS NOT NULL DROP TABLE dbo.Supplier;" & vbCrLf
    s = s & "IF OBJECT_ID('dbo.Unit','U') IS NOT NULL DROP TABLE dbo.Unit;" & vbCrLf
    s = s & "IF OBJECT_ID('dbo.Role','U') IS NOT NULL DROP TABLE dbo.Role;" & vbCrLf & "GO" & vbCrLf
    s = s & "CREATE TABLE dbo.Role (RoleId INT IDENTITY(1,1) CONSTRAINT PK_Role PRIMARY KEY, RoleName NVARCHAR(50) NOT NULL CONSTRAINT UQ_Role UNIQUE);" & vbCrLf
    s = s & "CREATE TABLE dbo.Unit (UnitId INT IDENTITY(1,1) CONSTRAINT PK_Unit PRIMARY KEY, UnitName NVARCHAR(20) NOT NULL CONSTRAINT UQ_Unit UNIQUE);" & vbCrLf
    s = s & "CREATE TABLE dbo.Supplier (SupplierId INT IDENTITY(1,1) CONSTRAINT PK_Supplier PRIMARY KEY, SupplierName NVARCHAR(100) NOT NULL CONSTRAINT UQ_Supplier UNIQUE);" & vbCrLf
    s = s & "CREATE TABLE dbo.Manufacturer (ManufacturerId INT IDENTITY(1,1) CONSTRAINT PK_Manufacturer PRIMARY KEY, ManufacturerName NVARCHAR(100) NOT NULL CONSTRAINT UQ_Manufacturer UNIQUE);" & vbCrLf
    s = s & "CREATE TABLE dbo.Category (CategoryId INT IDENTITY(1,1) CONSTRAINT PK_Category PRIMARY KEY, CategoryName NVARCHAR(100) NOT NULL CONSTRAINT UQ_Category UNIQUE);" & vbCrLf
    s = s & "CREATE TABLE dbo.OrderStatus (StatusId INT IDENTITY(1,1) CONSTRAINT PK_OrderStatus PRIMARY KEY, StatusName NVARCHAR(50) NOT NULL CONSTRAINT UQ_OrderStatus UNIQUE);" & vbCrLf & "GO" & vbCrLf
    s = s & "CREATE TABLE dbo.[User] (UserId INT IDENTITY(1,1) CONSTRAINT PK_User PRIMARY KEY, RoleId INT NOT NULL CONSTRAINT FK_User_Role REFERENCES dbo.Role(RoleId), FullName NVARCHAR(150) NOT NULL, Login NVARCHAR(100) NOT NULL CONSTRAINT UQ_User_Login UNIQUE, Password NVARCHAR(100) NOT NULL);" & vbCrLf
    s = s & "CREATE TABLE dbo.PickupPoint (PickupPointId INT NOT NULL CONSTRAINT PK_PickupPoint PRIMARY KEY, PostalCode NVARCHAR(10) NOT NULL, City NVARCHAR(80) NOT NULL, Street NVARCHAR(120) NOT NULL, House NVARCHAR(20) NOT NULL);" & vbCrLf
    s = s & "CREATE TABLE dbo.Product (ProductId INT IDENTITY(1,1) CONSTRAINT PK_Product PRIMARY KEY, Article NVARCHAR(10) NOT NULL CONSTRAINT UQ_Product_Article UNIQUE, Name NVARCHAR(255) NOT NULL, UnitId INT NOT NULL CONSTRAINT FK_Product_Unit REFERENCES dbo.Unit(UnitId), Price DECIMAL(10,2) NOT NULL CONSTRAINT CK_Price CHECK (Price>=0), SupplierId INT NOT NULL CONSTRAINT FK_Product_Supplier REFERENCES dbo.Supplier(SupplierId), ManufacturerId INT NOT NULL CONSTRAINT FK_Product_Manufacturer REFERENCES dbo.Manufacturer(ManufacturerId), CategoryId INT NOT NULL CONSTRAINT FK_Product_Category REFERENCES dbo.Category(CategoryId), Discount INT NOT NULL CONSTRAINT CK_Disc CHECK (Discount BETWEEN 0 AND 100), Stock INT NOT NULL CONSTRAINT CK_Stock CHECK (Stock>=0), Description NVARCHAR(MAX) NULL, Photo NVARCHAR(100) NULL);" & vbCrLf
    s = s & "CREATE TABLE dbo.[Order] (OrderId INT NOT NULL CONSTRAINT PK_Order PRIMARY KEY, OrderDate DATE NULL, DeliveryDate DATE NULL, PickupPointId INT NOT NULL CONSTRAINT FK_Order_Pickup REFERENCES dbo.PickupPoint(PickupPointId), ClientUserId INT NULL CONSTRAINT FK_Order_User REFERENCES dbo.[User](UserId), ReceiveCode INT NULL, StatusId INT NOT NULL CONSTRAINT FK_Order_Status REFERENCES dbo.OrderStatus(StatusId));" & vbCrLf
    s = s & "CREATE TABLE dbo.OrderItem (OrderItemId INT IDENTITY(1,1) CONSTRAINT PK_OrderItem PRIMARY KEY, OrderId INT NOT NULL CONSTRAINT FK_Item_Order REFERENCES dbo.[Order](OrderId) ON DELETE CASCADE, Article NVARCHAR(10) NOT NULL CONSTRAINT FK_Item_Product REFERENCES dbo.Product(Article), Quantity INT NOT NULL CONSTRAINT CK_Qty CHECK (Quantity>0), CONSTRAINT UQ_Item UNIQUE (OrderId, Article));" & vbCrLf & "GO" & vbCrLf
    SchemaSql = s
End Function

Private Function ViewsSql() As String
    Dim s As String
    s = "IF OBJECT_ID('dbo.vCatalog','V') IS NOT NULL DROP VIEW dbo.vCatalog;" & vbCrLf & "GO" & vbCrLf
    s = s & "CREATE VIEW dbo.vCatalog AS SELECT p.Article, p.Photo AS [Фото], c.CategoryName AS [Категория товара], p.Name AS [Наименование товара], p.Description AS [Описание товара], m.ManufacturerName AS [Производитель], s.SupplierName AS [Поставщик], p.Price AS [Цена], u.UnitName AS [Единица измерения], p.Stock AS [Кол-во на складе], p.Discount AS [Действующая скидка] FROM dbo.Product p JOIN dbo.Category c ON p.CategoryId=c.CategoryId JOIN dbo.Manufacturer m ON p.ManufacturerId=m.ManufacturerId JOIN dbo.Supplier s ON p.SupplierId=s.SupplierId JOIN dbo.Unit u ON p.UnitId=u.UnitId;" & vbCrLf & "GO" & vbCrLf
    s = s & "IF OBJECT_ID('dbo.vOrders','V') IS NOT NULL DROP VIEW dbo.vOrders;" & vbCrLf & "GO" & vbCrLf
    s = s & "CREATE VIEW dbo.vOrders AS SELECT o.OrderId, STRING_AGG(oi.Article + N' x' + CAST(oi.Quantity AS nvarchar(10)), N', ') AS [Артикул заказа], st.StatusName AS [Статус заказа], (pp.PostalCode + ', г. ' + pp.City + ', ул. ' + pp.Street + ', д. ' + pp.House) AS [Адрес пункта выдачи], o.OrderDate AS [Дата заказа], o.DeliveryDate AS [Дата доставки] FROM dbo.[Order] o JOIN dbo.OrderStatus st ON o.StatusId=st.StatusId JOIN dbo.PickupPoint pp ON o.PickupPointId=pp.PickupPointId LEFT JOIN dbo.OrderItem oi ON oi.OrderId=o.OrderId GROUP BY o.OrderId, st.StatusName, pp.PostalCode, pp.City, pp.Street, pp.House, o.OrderDate, o.DeliveryDate;" & vbCrLf & "GO" & vbCrLf
    s = s & "IF OBJECT_ID('dbo.vw_UsersLogin','V') IS NOT NULL DROP VIEW dbo.vw_UsersLogin;" & vbCrLf & "GO" & vbCrLf
    s = s & "CREATE VIEW dbo.vw_UsersLogin AS SELECT u.UserId, u.FullName AS [ФИО], u.Login AS [Логин], u.Password AS [Пароль], r.RoleName AS [Роль] FROM dbo.[User] u JOIN dbo.Role r ON u.RoleId=r.RoleId;" & vbCrLf & "GO" & vbCrLf
    ViewsSql = s
End Function

Private Sub SeedSql()
    Dim wsP As Worksheet, wsU As Worksheet, wsO As Worksheet, wsK As Worksheet, ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        If HasHeader(ws, "Артикул заказа") Then
            Set wsO = ws
        ElseIf HasHeader(ws, "Логин") Then
            Set wsU = ws
        ElseIf HasHeader(ws, "Артикул") Then
            Set wsP = ws
        ElseIf Trim(CStr(ws.Cells(1, 1).Value)) <> "" Then
            Set wsK = ws
        End If
    Next ws

    ' справочники
    If Not wsU Is Nothing Then DictInsert wsU, "Роль сотрудника", "dbo.Role", "RoleName"
    If Not wsP Is Nothing Then
        DictInsert wsP, "Единица измерения", "dbo.Unit", "UnitName"
        DictInsert wsP, "Поставщик", "dbo.Supplier", "SupplierName"
        DictInsert wsP, "Производитель", "dbo.Manufacturer", "ManufacturerName"
        DictInsert wsP, "Категория товара", "dbo.Category", "CategoryName"
    End If
    If Not wsO Is Nothing Then DictInsert wsO, "Статус заказа", "dbo.OrderStatus", "StatusName"
    Emit "GO"

    If Not wsU Is Nothing Then SeedUsers wsU
    If Not wsK Is Nothing Then SeedPickups wsK
    If Not wsP Is Nothing Then SeedProducts wsP
    If Not wsO Is Nothing Then SeedOrders wsO
    Emit "GO"
End Sub

Private Sub DictInsert(ws As Worksheet, header As String, tbl As String, col As String)
    Dim c As Long, r As Long, lastR As Long, v As String
    c = ColIdx(ws, header): If c = 0 Then Exit Sub
    lastR = LastRow(ws)
    Dim d As Object: Set d = CreateObject("Scripting.Dictionary")
    For r = 2 To lastR
        v = Trim(CStr(ws.Cells(r, c).Value))
        If Len(v) > 0 Then If Not d.Exists(v) Then d.Add v, 1
    Next r
    Dim k As Variant
    For Each k In d.Keys
        Emit "INSERT INTO " & tbl & "(" & col & ") VALUES (N'" & Esc(CStr(k)) & "');"
    Next k
End Sub

Private Sub SeedUsers(ws As Worksheet)
    Dim r As Long, lastR As Long
    Dim cR As Long, cF As Long, cL As Long, cP As Long
    cR = ColIdx(ws, "Роль сотрудника"): cF = ColIdx(ws, "ФИО"): cL = ColIdx(ws, "Логин"): cP = ColIdx(ws, "Пароль")
    lastR = LastRow(ws)
    For r = 2 To lastR
        If Len(Trim(CStr(ws.Cells(r, cL).Value))) > 0 Then
            Emit "INSERT INTO dbo.[User](RoleId,FullName,Login,Password) VALUES (" & _
                 "(SELECT RoleId FROM dbo.Role WHERE RoleName=N'" & Esc(CStr(ws.Cells(r, cR).Value)) & "')," & _
                 "N'" & Esc(CStr(ws.Cells(r, cF).Value)) & "',N'" & Esc(CStr(ws.Cells(r, cL).Value)) & "',N'" & Esc(CStr(ws.Cells(r, cP).Value)) & "');"
        End If
    Next r
End Sub

Private Sub SeedPickups(ws As Worksheet)
    Dim r As Long, lastR As Long, id As Long, addr As String
    Dim p() As String, postal As String, city As String, street As String, house As String
    lastR = LastRow(ws)
    id = 0
    For r = 1 To lastR   ' у пунктов выдачи шапки нет — берём со строки 1
        addr = Trim(CStr(ws.Cells(r, 1).Value))
        If Len(addr) > 0 Then
            id = id + 1
            p = Split(addr, ",")
            postal = "": city = "": street = "": house = ""
            If UBound(p) >= 0 Then postal = Trim(p(0))
            If UBound(p) >= 1 Then city = Trim(Replace(p(1), "г.", ""))
            If UBound(p) >= 2 Then street = Trim(Replace(p(2), "ул.", ""))
            If UBound(p) >= 3 Then house = Trim(p(3))
            Emit "INSERT INTO dbo.PickupPoint(PickupPointId,PostalCode,City,Street,House) VALUES (" & _
                 id & ",N'" & Esc(postal) & "',N'" & Esc(city) & "',N'" & Esc(street) & "',N'" & Esc(house) & "');"
        End If
    Next r
End Sub

Private Sub SeedProducts(ws As Worksheet)
    Dim r As Long, lastR As Long
    Dim cA, cN, cU, cPr, cS, cM, cC, cD, cQ, cDsc, cPh As Long
    cA = ColIdx(ws, "Артикул"): cN = ColIdx(ws, "Наименование товара"): cU = ColIdx(ws, "Единица измерения")
    cPr = ColIdx(ws, "Цена"): cS = ColIdx(ws, "Поставщик"): cM = ColIdx(ws, "Производитель")
    cC = ColIdx(ws, "Категория товара"): cD = ColIdx(ws, "Действующая скидка"): cQ = ColIdx(ws, "Кол-во на складе")
    cDsc = ColIdx(ws, "Описание товара"): cPh = ColIdx(ws, "Фото")
    lastR = LastRow(ws)
    For r = 2 To lastR
        If Len(Trim(CStr(ws.Cells(r, cA).Value))) > 0 Then
            Emit "INSERT INTO dbo.Product(Article,Name,UnitId,Price,SupplierId,ManufacturerId,CategoryId,Discount,Stock,Description,Photo) VALUES (" & _
                 "N'" & Esc(CStr(ws.Cells(r, cA).Value)) & "',N'" & Esc(CStr(ws.Cells(r, cN).Value)) & "'," & _
                 "(SELECT UnitId FROM dbo.Unit WHERE UnitName=N'" & Esc(CStr(ws.Cells(r, cU).Value)) & "')," & Num(ws.Cells(r, cPr).Value) & "," & _
                 "(SELECT SupplierId FROM dbo.Supplier WHERE SupplierName=N'" & Esc(CStr(ws.Cells(r, cS).Value)) & "')," & _
                 "(SELECT ManufacturerId FROM dbo.Manufacturer WHERE ManufacturerName=N'" & Esc(CStr(ws.Cells(r, cM).Value)) & "')," & _
                 "(SELECT CategoryId FROM dbo.Category WHERE CategoryName=N'" & Esc(CStr(ws.Cells(r, cC).Value)) & "')," & _
                 Num(ws.Cells(r, cD).Value) & "," & Num(ws.Cells(r, cQ).Value) & ",N'" & Esc(CStr(ws.Cells(r, cDsc).Value)) & "',N'" & Esc(CStr(ws.Cells(r, cPh).Value)) & "');"
        End If
    Next r
End Sub

Private Sub SeedOrders(ws As Worksheet)
    Dim r As Long, lastR As Long
    Dim cNum, cArt, cOd, cDd, cPk, cFio, cCode, cSt As Long
    cNum = ColIdx(ws, "Номер заказа"): cArt = ColIdx(ws, "Артикул заказа"): cOd = ColIdx(ws, "Дата заказа")
    cDd = ColIdx(ws, "Дата доставки"): cPk = ColIdx(ws, "Адрес пункта выдачи"): cFio = ColIdx(ws, "ФИО авторизированного клиента")
    cCode = ColIdx(ws, "Код для получения"): cSt = ColIdx(ws, "Статус заказа")
    lastR = LastRow(ws)
    For r = 2 To lastR
        Dim num As String: num = Trim(CStr(ws.Cells(r, cNum).Value))
        If Len(num) > 0 Then
            Emit "INSERT INTO dbo.[Order](OrderId,OrderDate,DeliveryDate,PickupPointId,ClientUserId,ReceiveCode,StatusId) VALUES (" & _
                 num & "," & DateVal(ws.Cells(r, cOd).Value) & "," & DateVal(ws.Cells(r, cDd).Value) & "," & Num(ws.Cells(r, cPk).Value) & "," & _
                 "(SELECT TOP 1 u.UserId FROM dbo.[User] u JOIN dbo.Role rl ON u.RoleId=rl.RoleId WHERE u.FullName=N'" & Esc(CStr(ws.Cells(r, cFio).Value)) & "' ORDER BY CASE WHEN rl.RoleName=N'Авторизированный клиент' THEN 0 ELSE 1 END, u.UserId)," & _
                 Num(ws.Cells(r, cCode).Value) & ",(SELECT StatusId FROM dbo.OrderStatus WHERE StatusName=N'" & Esc(CStr(ws.Cells(r, cSt).Value)) & "'));"
            ' позиции: "ART, qty, ART, qty"
            Dim p() As String, i As Long, art As String, qty As String
            p = Split(CStr(ws.Cells(r, cArt).Value), ",")
            For i = 0 To UBound(p) - 1 Step 2
                art = Trim(p(i)): qty = Trim(p(i + 1))
                If Len(art) > 0 And IsNumeric(qty) Then
                    Emit "INSERT INTO dbo.OrderItem(OrderId,Article,Quantity) VALUES (" & num & ",N'" & Esc(art) & "'," & qty & ");"
                End If
            Next i
        End If
    Next r
End Sub

Private Function ColIdx(ws As Worksheet, header As String) As Long
    Dim c As Long, lc As Long
    lc = LastCol(ws)
    For c = 1 To lc
        If Trim(CStr(ws.Cells(1, c).Value)) = header Then ColIdx = c: Exit Function
    Next c
    ColIdx = 0
End Function

Private Function HasHeader(ws As Worksheet, header As String) As Boolean
    HasHeader = (ColIdx(ws, header) > 0)
End Function

Private Function LastCol(ws As Worksheet) As Long
    LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
End Function

Private Function LastRow(ws As Worksheet) As Long
    LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
End Function

Private Function Num(ByVal v As Variant) As String
    If Len(CStr(v)) = 0 Then Num = "0" Else Num = Replace(CStr(v), ",", ".")
End Function

Private Function DateVal(ByVal v As Variant) As String
    If VarType(v) = vbDate Then DateVal = "'" & Format$(v, "yyyy-mm-dd") & "'" Else DateVal = "NULL"
End Function

Private Function Esc(ByVal s As String) As String
    Esc = Replace(s, "'", "''")
End Function

Private Sub WriteUtf8(ByVal path As String, ByVal text As String)
    Dim st As Object
    Set st = CreateObject("ADODB.Stream")
    st.Type = 2
    st.Charset = "utf-8"
    st.Open
    st.WriteText text
    st.SaveToFile path, 2
    st.Close
End Sub