84 lines
2.6 KiB
VB.net
84 lines
2.6 KiB
VB.net
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
|
|
|