1/ToyWorldDb.bas

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 ordId As String: ordId = Trim(CStr(ws.Cells(r, cNum).Value))
        If Len(ordId) > 0 Then
            Emit "INSERT INTO dbo.[Order](OrderId,OrderDate,DeliveryDate,PickupPointId,ClientUserId,ReceiveCode,StatusId) VALUES (" & _
                 ordId & "," & 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 (" & ordId & ",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