Attribute VB_Name = "工作表7"
'**************** 程式變數 ******************
Const strXLSfile = "\index.xlsm"             '資料來源
Const idxStart = 1810
Const idxEnd = 1849
Const idxRange = "argRange"
'********************************************

Private Sub CommandButton1_Click()
Dim sb As StringBuilder
Set sb = New StringBuilder

Dim strSQL As String
On Error GoTo Err_cmdYes_Click
Dim Cnmy As ADODB.Connection
Set Cnmy = Cnmyopen()

'清除舊資料
    sb.Append "delete FROM DEPARTMENT where id BETWEEN " & idxStart & " AND " & idxEnd & ";"
    Cnmy.Execute sb.ToString     '刪除站點
' 更新資料
    Call renewDepart(Cnmy)
    
Exit_cmdYes_Click:
    Exit Sub

Err_cmdYes_Click:
    MsgBox Err.Description
    Resume Exit_cmdYes_Click

End Sub

Public Sub renewDepart(Cnmy As ADODB.Connection)
'*************************************
Dim p As Long                       '*
Dim diag As New ProgressDialogue    '*
'*************************************
' 更新站點資料
Dim sb As StringBuilder
Set sb = New StringBuilder

Dim Cnxn As ADODB.Connection
Dim rstTBL As New ADODB.Recordset
Dim strSQL As String

Set Cnxn = Cnxnopen(strXLSfile, "1")

    sb.Append "Select 代碼 as id, 科別 as title, 代碼 as depart FROM [引數$" & _
    Replace(Sheets("引數").Range(idxRange).Address, "$", "") & "];"
' Debug.Print sb.toString
    rstTBL.Open sb.ToString, Cnxn, adOpenStatic, adLockOptimistic, adCmdText
'*************************************************************************************
p = 0                                                                               '*
diag.Configure "Wasting Time", "Now wasting your time...", 0, rstTBL.RecordCount    '*
diag.Show                                                                           '*
'*************************************************************************************
    sb.Clear
    sb.Append "INSERT INTO DEPARTMENT(id,title,depart) VALUES "
    
    While Not (rstTBL.EOF Or diag.cancelIsPressed)
        If Not IsNull(rstTBL.Fields.item("title")) Then
            sb.Append "(" & rstTBL.Fields.item("id") & ",'"
            sb.Append rstTBL.Fields.item("title") & "','"
            sb.Append rstTBL.Fields.item("depart") & "')"
        End If
        rstTBL.MoveNext
        If Not rstTBL.EOF Then
            sb.Append ","
        End If
'*************************************************
diag.SetValue p                                 '*
diag.SetStatus "Now wasting your time... " & p  '*
p = p + 1                                       '*
'*************************************************
    Wend
' Debug.Print sb.toString
    Cnmy.Execute sb.ToString
    rstTBL.Close
'*************
diag.Hide   '*
'*************
End Sub