加入 CodeStore VBA 模組

CodeStore/index.xlsm_工作表7.bas

@@ -0,0 +1,83 @@
+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
+