Attribute VB_Name = "modStaffImport"
Option Explicit
'=====================================================================
' modStaffImport : [ºÎ¼­¸í´Ü ÆÄÀÏ] - ¼º¸í¡¤ÆÀ/ºÎ¼­ ¸í´Ü ÆÄÀÏ ºÒ·¯¿À±â
'   Áö¿ø: XLSX/XLS/XLSM (¿¢¼¿), DOCX/DOC (Word ÀÚµ¿È­, Ç¥), HWPX (¾ÐÃà ÇØÁ¦ ÈÄ XML Ç¥ ÆĽÌ),
'         HWP (ÇÑÄÄ ¿ÀÇǽº ÀÚµ¿È­·Î HWPX º¯È¯ ÈÄ ÆÄ½Ì - ÇѱÛÀÌ ¼³Ä¡µÇ¾î ÀÖ¾î¾ß ÇÔ)
'   ±ÔÄ¢: Ç¥¿¡¼­ '¼º¸í/À̸§' ¿­°ú 'ÆÀ/ºÎ¼­/¼Ò¼Ó' ¿­À» ¸Ó¸®±Û·Î ãÀ½ ¡æ ¾øÀ¸¸é 1¿­=¼º¸í, 2¿­=ÆÀ
'         'Á÷À§/Á÷±Þ' ¿­ÀÌ ÀÖÀ¸¸é Á÷À§µµ ÀÔ·Â. ºÎ¼­´ã´çÀÚ ½ÃÆ® 5ÇàºÎÅÍ ±â·Ï(±âÁ¸ ³»¿ë ±³Ã¼)
'=====================================================================

Public Sub ºÎ¼­¸í´ÜÆÄÀϼ±ÅÃ()
    Dim f As Variant, rows As Collection, ext As String
    f = Application.GetOpenFilename("¸í´Ü ÆÄÀÏ (*.xlsx;*.xls;*.xlsm;*.docx;*.doc;*.hwpx;*.hwp),*.xlsx;*.xls;*.xlsm;*.docx;*.doc;*.hwpx;*.hwp", , "ºÎ¼­¸í´Ü ÆÄÀÏ ¼±ÅÃ")
    If VarType(f) = vbBoolean Then Exit Sub
    ext = LCase(Mid(f, InStrRev(f, ".") + 1))
    On Error GoTo EH
    SpeedOn "¸í´Ü ÆÄÀÏ Àд Áß..."
    Select Case ext
        Case "xlsx", "xls", "xlsm": Set rows = ReadExcelRows(CStr(f))
        Case "docx", "doc": Set rows = ReadWordRows(CStr(f))
        Case "hwpx": Set rows = ReadHwpxRows(CStr(f))
        Case "hwp": Set rows = ReadHwpRows(CStr(f))
        Case Else: Err.Raise 1000, , "Áö¿øÇÏÁö ¾Ê´Â Çü½Ä: " & ext
    End Select
    SpeedOff
    If rows Is Nothing Then Exit Sub
    If rows.Count = 0 Then
        MsgBox "ÆÄÀÏ¿¡¼­ Ç¥(¸í´Ü)¸¦ ãÁö ¸øÇß½À´Ï´Ù." & vbCrLf & "¼º¸í¡¤ÆÀ/ºÎ¼­ ¿­ÀÌ Àִ ǥ ÇüÅÂÀÇ ÆÄÀÏÀ» ¼±ÅÃÇϼ¼¿ä.", vbExclamation
        Exit Sub
    End If
    WriteStaffRows rows
    Exit Sub
EH:
    SpeedOff
    MsgBox "ºÎ¼­¸í´Ü ÆÄÀÏ ¿À·ù: " & Err.Description, vbCritical
End Sub

'---------------------------------------------------------------- ½ÃÆ® ±â·Ï
Private Sub WriteStaffRows(rows As Collection)
    Dim cName As Long, cTeam As Long, cPos As Long, hdrIdx As Long, i As Long, row As Variant, j As Long, T As String
    Dim ws As Worksheet, r As Long, n As Long, nm As String, seen As Object
    '¸Ó¸®±Û Çà Ž»ö (óÀ½ 20Çà)
    cName = 0: cTeam = 0: cPos = 0: hdrIdx = 0
    For i = 1 To IIf(rows.Count < 20, rows.Count, 20)
        row = rows(i)
        For j = LBound(row) To UBound(row)
            T = Replace(CleanText(row(j)), " ", "")
            If cName = 0 Then If T = "¼º¸í" Or T = "À̸§" Or T = "´ã´çÀÚ" Or T = "¼º¸í(À̸§)" Then cName = j: hdrIdx = i
            If cTeam = 0 Then If InStr(T, "ÆÀ") > 0 Or InStr(T, "ºÎ¼­") > 0 Or InStr(T, "¼Ò¼Ó") > 0 Then If Len(T) <= 8 Then cTeam = j: hdrIdx = i
            If cPos = 0 Then If T = "Á÷À§" Or T = "Á÷±Þ" Or T = "Á÷Ã¥" Then cPos = j
        Next j
        If cName > 0 And cTeam > 0 Then Exit For
    Next i
    If cName = 0 Then
        '¸Ó¸®±Û ¾øÀ½: 1¿­ ¼º¸í, 2¿­ ÆÀ
        row = rows(1)
        cName = LBound(row): cTeam = LBound(row) + 1: hdrIdx = 0
        If cTeam > UBound(row) Then cTeam = 0
    ElseIf cTeam = 0 Then
        row = rows(hdrIdx)
        cTeam = IIf(cName + 1 <= UBound(row), cName + 1, 0)
    End If

    If Not SheetExists(SH_STAFF) Then RefreshStaffSheet False
    Set ws = BW().Worksheets(SH_STAFF)
    '±âÁ¸ ¸í´Ü(5Çà~, A:E) Áö¿ì±â
    r = lastRow(ws, 1)
    If r >= 5 Then ws.Range(ws.cells(5, 1), ws.cells(r, 5)).ClearContents
    Set seen = CreateObject("Scripting.Dictionary")
    r = 4
    For i = hdrIdx + 1 To rows.Count
        row = rows(i)
        If cName >= LBound(row) And cName <= UBound(row) Then
            nm = CleanText(row(cName))
            nm = Replace(nm, " ", "")
            If nm <> "" And Len(nm) <= 10 And Not seen.Exists(nm) And nm <> "¼º¸í" And nm <> "À̸§" Then
                seen.Add nm, 1
                r = r + 1: n = n + 1
                ws.cells(r, 1).Value2 = nm
                If cTeam > 0 Then If cTeam <= UBound(row) Then ws.cells(r, 2).Value2 = CleanText(row(cTeam))
                If cPos > 0 Then If cPos <= UBound(row) Then ws.cells(r, 3).Value2 = CleanText(row(cPos))
            End If
        End If
    Next i
    If n = 0 Then
        MsgBox "¼º¸íÀ» ãÁö ¸øÇß½À´Ï´Ù. (¼º¸í/À̸§ ¿­ È®ÀÎ)", vbExclamation
        Exit Sub
    End If
    StyleBody ws.Range(ws.cells(5, 1), ws.cells(r, 5))
    ws.Range(ws.cells(5, 2), ws.cells(r, 4)).Interior.color = RGB(255, 255, 224)
    ws.Activate
    If MsgBox(n & "¸íÀ» ºÒ·¯¿Ô½À´Ï´Ù (¼º¸í¡¤ÆÀ/ºÎ¼­" & IIf(cPos > 0, "¡¤Á÷À§", "") & ")." & vbCrLf & vbCrLf & _
              "Áö±Ý [Àû¿ë] ÇÏ¿© ¸ÞÀÎ º¸µå¿¡ ¹Ý¿µÇÒ±î¿ä?", vbYesNo + vbQuestion, "ºÎ¼­¸í´Ü ÆÄÀÏ") = vbYes Then Àû¿ë
End Sub

'---------------------------------------------------------------- ¿¢¼¿
Private Function ReadExcelRows(ByVal path As String) As Collection
    Dim wb As Workbook, ws As Worksheet, col As New Collection, arr As Variant, r As Long, c As Long, v() As Variant, best As Worksheet, bestN As Long
    Set wb = Workbooks.Open(path, ReadOnly:=True, UpdateLinks:=0)
    'µ¥ÀÌÅÍ°¡ °¡Àå ¸¹Àº ½ÃÆ® »ç¿ë
    For Each ws In wb.Worksheets
        If Application.WorksheetFunction.CountA(ws.cells) > bestN Then bestN = Application.WorksheetFunction.CountA(ws.cells): Set best = ws
    Next ws
    If Not best Is Nothing Then
        arr = best.usedRange.Value2
        If IsArray(arr) Then
            For r = LBound(arr, 1) To UBound(arr, 1)
                ReDim v(1 To UBound(arr, 2) - LBound(arr, 2) + 1)
                For c = LBound(arr, 2) To UBound(arr, 2)
                    v(c - LBound(arr, 2) + 1) = arr(r, c)
                Next c
                col.Add v
            Next r
        End If
    End If
    wb.Close False
    Set ReadExcelRows = col
End Function

'---------------------------------------------------------------- Word (Ç¥)
Private Function ReadWordRows(ByVal path As String) As Collection
    Dim wa As Object, doc As Object, tB As Object, col As New Collection, r As Long, c As Long, v() As Variant, s As String
    On Error Resume Next
    Set wa = CreateObject("Word.Application")
    On Error GoTo 0
    If wa Is Nothing Then Err.Raise 1001, , "Word ¸¦ ¿­ ¼ö ¾ø½À´Ï´Ù. DOCX ´Â Word °¡ ¼³Ä¡µÇ¾î ÀÖ¾î¾ß ÇÕ´Ï´Ù."
    wa.Visible = False
    Set doc = wa.Documents.Open(path, ReadOnly:=True, AddToRecentFiles:=False)
    For Each tB In doc.Tables
        For r = 1 To tB.rows.Count
            ReDim v(1 To tB.Columns.Count)
            For c = 1 To tB.Columns.Count
                On Error Resume Next
                s = tB.cell(r, c).Range.text
                On Error GoTo 0
                s = Replace(Replace(s, Chr(13), ""), Chr(7), "")
                v(c) = s
            Next c
            col.Add v
        Next r
    Next tB
    doc.Close False
    wa.Quit
    Set ReadWordRows = col
End Function

'---------------------------------------------------------------- HWPX (zip ¾ÈÀÇ Contents/section*.xml Ç¥ ÆĽÌ)
Private Function ReadHwpxRows(ByVal path As String) As Collection
    Dim fso As Object, tmp As String, zipPath As String, Sh As Object, col As New Collection, f As Object, xml As String
    Set fso = CreateObject("Scripting.FileSystemObject")
    tmp = fso.GetSpecialFolder(2) & "\hwpx_" & Format(Now, "hhmmss")
    fso.CreateFolder tmp
    zipPath = tmp & "\src.zip"
    fso.CopyFile path, zipPath
    Set Sh = CreateObject("Shell.Application")
    Sh.Namespace(CVar(tmp)).CopyHere Sh.Namespace(CVar(zipPath)).items, 4 + 16 + 1024
    Dim t0 As Single: t0 = Timer
    Do While Not fso.FolderExists(tmp & "\Contents") And Timer - t0 < 10: DoEvents: Loop
    If Not fso.FolderExists(tmp & "\Contents") Then Err.Raise 1002, , "HWPX ¾ÐÃà ÇØÁ¦ ½ÇÆÐ"
    For Each f In fso.GetFolder(tmp & "\Contents").files
        If LCase(Left(f.name, 7)) = "section" And LCase(Right(f.name, 4)) = ".xml" Then
            xml = ReadUtf8(f.path)
            ParseHwpxTables xml, col
        End If
    Next f
    On Error Resume Next
    fso.DeleteFolder tmp, True
    On Error GoTo 0
    Set ReadHwpxRows = col
End Function

Private Sub ParseHwpxTables(ByVal xml As String, col As Collection)
    Dim re As Object, mTr As Object, mTc As Object, mT As Object, tr As Variant, tc As Variant, v() As Variant, n As Long, s As String, m As Variant
    Set re = CreateObject("VBScript.RegExp")
    re.Global = True: re.IgnoreCase = True
    re.pattern = "<hp:tr\b[\s\S]*?</hp:tr>"
    Set mTr = re.Execute(xml)
    Dim reTc As Object, reT As Object, reTag As Object
    Set reTc = CreateObject("VBScript.RegExp"): reTc.Global = True: reTc.pattern = "<hp:tc\b[\s\S]*?</hp:tc>"
    Set reT = CreateObject("VBScript.RegExp"): reT.Global = True: reT.pattern = "<hp:t\b[^>]*>([\s\S]*?)</hp:t>"
    Set reTag = CreateObject("VBScript.RegExp"): reTag.Global = True: reTag.pattern = "<[^>]+>"
    For Each tr In mTr
        Set mTc = reTc.Execute(tr.value)
        If mTc.Count > 0 Then
            ReDim v(1 To mTc.Count)
            n = 0
            For Each tc In mTc
                n = n + 1: s = ""
                Set mT = reT.Execute(tc.value)
                For Each m In mT
                    s = s & reTag.Replace(m.SubMatches(0), "")
                Next m
                s = Replace(Replace(Replace(s, "&amp;", "&"), "&lt;", "<"), "&gt;", ">")
                v(n) = s
            Next tc
            col.Add v
        End If
    Next tr
End Sub

Private Function ReadUtf8(ByVal path As String) As String
    Dim st As Object
    Set st = CreateObject("ADODB.Stream")
    st.Type = 2: st.Charset = "utf-8": st.Open: st.LoadFromFile path
    ReadUtf8 = st.ReadText
    st.Close
End Function

'---------------------------------------------------------------- HWP (ÇÑÄÄ ÀÚµ¿È­ ¡æ HWPX º¯È¯)
Private Function ReadHwpRows(ByVal path As String) As Collection
    Dim hwp As Object, tmp As String, fso As Object
    On Error Resume Next
    Set hwp = CreateObject("HWPFrame.HwpObject")
    On Error GoTo 0
    If hwp Is Nothing Then Err.Raise 1003, , "ÇѱÛ(HWP) ÀÚµ¿È­¸¦ »ç¿ëÇÒ ¼ö ¾ø½À´Ï´Ù. Çѱۿ¡¼­ HWPX ¶Ç´Â XLSX ·Î ÀúÀåÇÑ µÚ ´Ù½Ã ¼±ÅÃÇϼ¼¿ä."
    On Error Resume Next
    hwp.RegisterModule "FilePathCheckDLL", "FilePathCheckerModule"
    On Error GoTo 0
    Set fso = CreateObject("Scripting.FileSystemObject")
    tmp = fso.GetSpecialFolder(2) & "\hwp_" & Format(Now, "hhmmss") & ".hwpx"
    If Not hwp.Open(path, "HWP", "forceopen:true") Then Err.Raise 1004, , "HWP ÆÄÀÏÀ» ¿­ ¼ö ¾ø½À´Ï´Ù."
    hwp.SaveAs tmp, "HWPX"
    hwp.Quit
    Set ReadHwpRows = ReadHwpxRows(tmp)
    On Error Resume Next
    fso.DeleteFile tmp
    On Error GoTo 0
End Function