'@Folder modRepositoryExport
Option Explicit

' ==========================================================
'  Excel VBA ÇÁ·ÎÁ§Æ® ³»º¸³»±â µµ±¸
'  ´ë»ó: È°¼º ÅëÇÕ ¹®¼­ÀÇ VBProject
'
'  Ãâ·Â:
'   - UserForm          ¡æ FormsCsv / FormCode
'   - Ç¥ÁØ ¸ðµâ         ¡æ Modules
'   - Ŭ·¡½º ¸ðµâ       ¡æ Classes
'   - ThisWorkbook/Sheet ¡æ Documents
' ==========================================================

Private Const vbext_ct_StdModule As Long = 1
Private Const vbext_ct_ClassModule As Long = 2
Private Const vbext_ct_MSForm As Long = 3
Private Const vbext_ct_Document As Long = 100

Private Const vbext_pp_locked As Long = 1

Private Const MAX_FILES_IN_MESSAGE As Long = 20

' À̹ø ³»º¸³»±â¿¡¼­ ¾´ ÆÄÀÏ °æ·Î(¼Ò¹®ÀÚ) ¸ñ·Ï
Private m_exportedFiles As Object

Public Sub ExportRepositoryForActiveWorkbook()

    Dim wb As Workbook
    Dim vbproj As Object
    Dim vbComp As Object
    Dim currentTarget As String
    Dim staleMessage As String

    Dim baseFolder As String
    Dim formsCsvFolder As String
    Dim formCodeFolder As String
    Dim modulesFolder As String
    Dim classesFolder As String
    Dim documentsFolder As String
    
    Set wb = ActiveWorkbook
    
    If wb Is Nothing Then
        MsgBox "È°¼ºÈ­µÈ ÅëÇÕ ¹®¼­°¡ ¾ø½À´Ï´Ù.", vbExclamation
        Exit Sub
    End If
    
    If wb.Path = vbNullString Then
        MsgBox "ÅëÇÕ ¹®¼­°¡ ¾ÆÁ÷ ÀúÀåµÇÁö ¾Ê¾Ò½À´Ï´Ù. ¸ÕÀú ÀúÀåÇØ ÁÖ¼¼¿ä.", vbExclamation
        Exit Sub
    End If
    
    Set vbproj = GetVBProjectSafe(wb)
    If vbproj Is Nothing Then Exit Sub

    Dim repositoryRoot As String
    Dim vbaFolder As String
    Dim formsFolder As String
    
    repositoryRoot = wb.Path & "\ExcelRepository"
    baseFolder = repositoryRoot & "\" & GetNameWithoutExtension(wb.Name) & "_repository"
    vbaFolder = baseFolder & "\VBA"
    
    formsFolder = vbaFolder & "\Forms"
    formCodeFolder = formsFolder & "\Code"
    formsCsvFolder = formsFolder & "\ControlsCsv"
    modulesFolder = vbaFolder & "\Modules"
    classesFolder = vbaFolder & "\Classes"
    documentsFolder = vbaFolder & "\Documents"
    
    CreateFolderIfNotExists repositoryRoot
    CreateFolderIfNotExists baseFolder
    CreateFolderIfNotExists vbaFolder
    CreateFolderIfNotExists formsFolder
    CreateFolderIfNotExists formsCsvFolder
    CreateFolderIfNotExists formCodeFolder
    CreateFolderIfNotExists modulesFolder
    CreateFolderIfNotExists classesFolder
    CreateFolderIfNotExists documentsFolder

    Set m_exportedFiles = CreateObject("Scripting.Dictionary")

    On Error GoTo Err_Handler

    For Each vbComp In vbproj.VBComponents
        currentTarget = vbComp.Name

        Select Case vbComp.Type
            Case vbext_ct_MSForm
                ExportFormControlsToCsv vbComp, formsCsvFolder
                ExportFormCodeToCls vbComp, formCodeFolder
                
            Case vbext_ct_StdModule
                ExportStdModuleToBas vbComp, modulesFolder
                
            Case vbext_ct_ClassModule
                ExportClassModuleToCls vbComp, classesFolder
                
            Case vbext_ct_Document
                ExportDocumentModuleCodeOnly vbComp, documentsFolder
                
            Case Else
                ' ´ë»ó ¾Æ´Ô
        End Select
    Next vbComp

    currentTarget = "Workbook Á¤º¸"
    Call ExportWorkbookRepository(wb, baseFolder)

    On Error GoTo 0

    ' Excel¿¡¼­ Áö¿î ¸ðµâÀÇ ÆÄÀÏÀÌ ³²¾Æ ÀÖÀ¸¸é
    ' Restorer°¡ ±× ¸ðµâÀ» µÇ»ì¸®¹Ç·Î Á¤¸®ÇÑ´Ù
    staleMessage = CleanUpStaleFiles(baseFolder, Array( _
                        Array(modulesFolder, "bas"), _
                        Array(classesFolder, "cls"), _
                        Array(documentsFolder, "cls"), _
                        Array(formCodeFolder, "cls"), _
                        Array(formsCsvFolder, "csv")))

    MsgBox "³»º¸³»±â ¿Ï·á: " & vbCrLf & baseFolder & staleMessage, vbInformation
    Exit Sub

Err_Handler:
    MsgBox "³»º¸³»±â Áß ¿À·ù°¡ ¹ß»ýÇØ Áß´ÜÇß½À´Ï´Ù." & vbCrLf & _
           "´ë»ó: " & currentTarget & vbCrLf & _
           Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
           "Ãâ·Â Æú´õÀÇ ÆÄÀÏÀÌ ÀϺθ¸ °»½ÅµÇ¾úÀ» ¼ö ÀÖ½À´Ï´Ù.", vbCritical

End Sub

' ==========================================================
'  ³²Àº ÆÄÀÏ Á¤¸®
' ==========================================================

' folderSpecs: Array(Array(Æú´õ, È®ÀåÀÚ), ...)
' ¹Ýȯ°ª: ¿Ï·á ¸Þ½ÃÁö µÚ¿¡ ºÙÀÏ ¾È³» ¹®±¸
Private Function CleanUpStaleFiles(ByVal baseFolder As String, ByVal folderSpecs As Variant) As String

    Dim fso As Object
    Dim file As Object
    Dim staleFiles As Collection
    Dim spec As Variant
    Dim message As String
    Dim i As Long

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set staleFiles = New Collection

    For Each spec In folderSpecs
        If fso.FolderExists(spec(0)) Then
            For Each file In fso.GetFolder(spec(0)).Files
                If LCase$(fso.GetExtensionName(file.Name)) = spec(1) Then
                    If Not m_exportedFiles.Exists(LCase$(file.Path)) Then
                        staleFiles.Add file.Path
                    End If
                End If
            Next file
        End If
    Next spec

    If staleFiles.Count = 0 Then Exit Function

    message = "Excel¿¡´Â ´õ ÀÌ»ó ¾ø´Â ±¸¼º ¿ä¼ÒÀÇ ÆÄÀÏÀÌ " & staleFiles.Count & "°³ ³²¾Æ ÀÖ½À´Ï´Ù." & vbCrLf & _
              "±×´ë·Î µÎ¸é Restorer°¡ ÀÌ ÆÄÀϵéÀ» ´Ù½Ã Excel·Î °¡Á®¿É´Ï´Ù." & vbCrLf & vbCrLf

    For i = 1 To staleFiles.Count
        If i > MAX_FILES_IN_MESSAGE Then
            message = message & "¡¦ ¿Ü " & (staleFiles.Count - MAX_FILES_IN_MESSAGE) & "°³" & vbCrLf
            Exit For
        End If
        message = message & "- " & Mid$(staleFiles(i), Len(baseFolder) + 2) & vbCrLf
    Next i

    message = message & vbCrLf & "ÀÌ ÆÄÀϵéÀ» »èÁ¦ÇÒ±î¿ä?" & vbCrLf & _
              "(GitÀ¸·Î °ü¸® ÁßÀÌ¸é ³ªÁß¿¡ µÇµ¹¸± ¼ö ÀÖ½À´Ï´Ù)"

    If MsgBox(message, vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then
        For i = 1 To staleFiles.Count
            fso.DeleteFile staleFiles(i), True
        Next i
        CleanUpStaleFiles = vbCrLf & vbCrLf & "³²¾Æ ÀÖ´ø ÆÄÀÏ " & staleFiles.Count & "°³¸¦ »èÁ¦Çß½À´Ï´Ù."
    Else
        CleanUpStaleFiles = vbCrLf & vbCrLf & "ÁÖÀÇ: ³²¾Æ ÀÖ´ø ÆÄÀÏ " & staleFiles.Count & "°³¸¦ ±×´ë·Î µÎ¾ú½À´Ï´Ù." & vbCrLf & _
                            "°¡Á®¿À±â Àü¿¡ Á÷Á¢ Á¤¸®ÇØ ÁÖ¼¼¿ä."
    End If

End Function

Private Sub RegisterExportedFile(ByVal filePath As String)

    m_exportedFiles(LCase$(filePath)) = True

End Sub

' ==========================================================
'  UserForm
' ==========================================================

Private Sub ExportFormControlsToCsv(ByVal vbComp As Object, ByVal folderPath As String)

    Dim designer As Object
    Dim ctrl As Object
    Dim filePath As String
    Dim line As String
    Dim allText As String
    
    On Error Resume Next
    Set designer = vbComp.designer
    On Error GoTo 0
    
    If designer Is Nothing Then Exit Sub
    
    filePath = folderPath & "\" & vbComp.Name & ".csv"
    
    allText = "ControlName,ControlType,Caption,Left,Top,Width,Height," & _
              "FontName,FontSize,FontBold,ForeColor,BackColor" & vbCrLf

    For Each ctrl In designer.Controls
    
        line = EscapeCsv(ctrl.Name) & "," & _
               EscapeCsv(TypeName(ctrl)) & "," & _
               EscapeCsv(GetCtrlCaptionSafe(ctrl)) & "," & _
               CStr(ctrl.Left) & "," & _
               CStr(ctrl.Top) & "," & _
               CStr(ctrl.Width) & "," & _
               CStr(ctrl.Height) & "," & _
               EscapeCsv(GetCtrlPropertySafe(ctrl, "Font.Name")) & "," & _
               EscapeCsv(GetCtrlPropertySafe(ctrl, "Font.Size")) & "," & _
               EscapeCsv(GetCtrlPropertySafe(ctrl, "Font.Bold")) & "," & _
               EscapeCsv(GetCtrlPropertySafe(ctrl, "ForeColor")) & "," & _
               EscapeCsv(GetCtrlPropertySafe(ctrl, "BackColor"))
    
        allText = allText & line & vbCrLf
    
    Next ctrl

    Call SaveUtf8NoBom(filePath, allText)
    RegisterExportedFile filePath

End Sub

Private Sub ExportFormCodeToCls(ByVal vbComp As Object, ByVal folderPath As String)

    Dim cm As Object
    Dim codeText As String
    Dim filePath As String
    Dim lineCount As Long
    
    Set cm = vbComp.CodeModule
    lineCount = cm.CountOfLines
    If lineCount <= 0 Then Exit Sub
    
    codeText = cm.lines(1, lineCount)
    codeText = RemoveAttributeLines(codeText)
    
    filePath = folderPath & "\" & vbComp.Name & ".cls"

    Call SaveUtf8NoBom(filePath, codeText)
    RegisterExportedFile filePath

End Sub

' ==========================================================
'  Ç¥ÁØ ¸ðµâ / Ŭ·¡½º ¸ðµâ / Document ¸ðµâ
' ==========================================================

Private Sub ExportStdModuleToBas(ByVal vbComp As Object, ByVal folderPath As String)

    Dim filePath As String
    
    filePath = folderPath & "\" & vbComp.Name & ".bas"

    vbComp.Export filePath
    Call ConvertExportedFileToUtf8(filePath)
    RegisterExportedFile filePath

End Sub

Private Sub ExportClassModuleToCls(ByVal vbComp As Object, ByVal folderPath As String)

    Dim filePath As String
    
    filePath = folderPath & "\" & vbComp.Name & ".cls"

    vbComp.Export filePath
    Call ConvertExportedFileToUtf8(filePath)
    RegisterExportedFile filePath

End Sub

Private Sub ExportDocumentModuleCodeOnly(ByVal vbComp As Object, ByVal folderPath As String)

    Dim filePath As String
    Dim codeText As String
    Dim lineCount As Long

    filePath = folderPath & "\" & vbComp.Name & ".cls"

    With vbComp.CodeModule
        lineCount = .CountOfLines
        If lineCount > 0 Then
            codeText = .lines(1, lineCount)
            codeText = RemoveAttributeLines(codeText)
        End If
    End With

    ' ANSI ÆÄÀÏÀ» °ÅÄ¡Áö ¾Ê°í ¹Ù·Î UTF-8·Î ÀúÀåÇÑ´Ù
    ' (°ÅÄ¡¸é CP949¿¡ ¾ø´Â ¹®ÀÚ°¡ ±úÁø´Ù)
    Call SaveUtf8NoBom(filePath, codeText)
    RegisterExportedFile filePath

End Sub

' ==========================================================
'  ÇïÆÛ
' ==========================================================

Private Function GetNameWithoutExtension(ByVal fileName As String) As String

    Dim pos As Long
    
    pos = InStrRev(fileName, ".")
    
    If pos > 0 Then
        GetNameWithoutExtension = Left$(fileName, pos - 1)
    Else
        GetNameWithoutExtension = fileName
    End If

End Function

Private Sub CreateFolderIfNotExists(ByVal folderPath As String)

    Dim fso As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    If Not fso.FolderExists(folderPath) Then
        fso.CreateFolder folderPath
    End If

End Sub

Private Function GetCtrlCaptionSafe(ByVal ctrl As Object) As String

    On Error Resume Next
    GetCtrlCaptionSafe = ctrl.caption
    
    If Err.Number <> 0 Then
        GetCtrlCaptionSafe = vbNullString
        Err.Clear
    End If
    
    On Error GoTo 0

End Function

Private Function EscapeCsv(ByVal text As String) As String

    Dim t As String
    
    t = Replace(text, """", """""")
    EscapeCsv = """" & t & """"

End Function

' vbComp.Export °¡ ¸¸µç ANSI ÆÄÀÏÀ» UTF-8·Î ¹Ù²Û´Ù.
' ±âº»°ª Attribute ÁÙ¸¸ Áö¿ì°í, VB_PredeclaredId = True ó·³
' µ¿ÀÛ¿¡ ¿µÇâÀ» ÁÖ´Â Attribute ÁÙÀº ³²±ä´Ù.
Private Sub ConvertExportedFileToUtf8(ByVal filePath As String)

    Dim textData As String

    If Dir$(filePath) = vbNullString Then Exit Sub

    textData = ReadTextFile(filePath)
    textData = RemoveDefaultAttributeLines(textData)

    Call SaveUtf8NoBom(filePath, textData)

End Sub

Private Function GetVBProjectSafe(ByVal wb As Workbook) As Object

    Dim vbproj As Object

    On Error Resume Next
    Set vbproj = wb.VBProject
    On Error GoTo 0

    If vbproj Is Nothing Then
        MsgBox "VBA ÇÁ·ÎÁ§Æ®¿¡ Á¢±ÙÇÒ ¼ö ¾ø½À´Ï´Ù." & vbCrLf & _
               "º¸¾È ¼¾ÅÍ¿¡¼­ 'VBA ÇÁ·ÎÁ§Æ® °³Ã¼ ¸ðµ¨¿¡ ¾ÈÀüÇÏ°Ô ¾×¼¼½ºÇÒ ¼ö ÀÖÀ½'À» ÄÑ ÁÖ¼¼¿ä.", vbExclamation
        Exit Function
    End If

    If vbproj.Protection = vbext_pp_locked Then
        MsgBox "VBA ÇÁ·ÎÁ§Æ®°¡ ¾ÏÈ£·Î Àá°Ü ÀÖ½À´Ï´Ù. Àá±ÝÀ» Ǭ µÚ ´Ù½Ã ½ÇÇàÇØ ÁÖ¼¼¿ä.", vbExclamation
        Exit Function
    End If

    Set GetVBProjectSafe = vbproj

End Function

Private Function GetCtrlPropertySafe(ByVal ctrl As Object, ByVal propertyName As String) As String

    On Error GoTo Err_Handler

    Select Case propertyName

        Case "Font.Name"
            GetCtrlPropertySafe = CStr(ctrl.Font.Name)

        Case "Font.Size"
            GetCtrlPropertySafe = CStr(ctrl.Font.Size)

        Case "Font.Bold"
            GetCtrlPropertySafe = CStr(ctrl.Font.Bold)

        Case Else
            GetCtrlPropertySafe = CStr(CallByName(ctrl, propertyName, VbGet))

    End Select

    Exit Function

Err_Handler:
    GetCtrlPropertySafe = vbNullString

End Function