1019

ACE資料連線
 Dim myconn As New ADODB.Connection
    Dim myrs As New ADODB.Recordset
    Dim sql As String
 
    myconn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=E:\20160905\VBAproject\hope01.xlsx;Extended Properties=Excel 12.0;"
    myconn.CommandTimeout = 40
    myconn.Open
    sql = "select * from [工作表1$]"
    myrs.Open sql, myconn
 
    MsgBox "excel 檔案已找到"
 
    myrs.Close
    myconn.Close
    Set myrs = Nothing
    Set myconn = Nothing
==================================
Private Sub CommandButton1_Click()
    Dim sql, last As String
    sql = "select * from "
    last = ""
    Call browserdata(sql, 1, 4, last)
End Sub
===================================
Public Sub browserdata(ByVal sql, f4, t2, fin As String)
On Error Resume Next
    Dim myconn As New ADODB.Connection
    Dim myrs As New ADODB.Recordset
    myconn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\appserv\chin1.xlsx;Extended Properties=Excel 12.0;"
    myconn.ConnectionTimeout = 40
    myconn.Open
 
    Cells.Clear
    Cells(1, 1) = "編號"
    Cells(1, 2) = "姓名"
    Cells(1, 3) = "生日"
    Cells(1, 4) = "血型"
    Cells(1, 5) = "學歷"
    Dim sqr As String
    Dim i As Integer
    For i = CInt(f4) To CInt(t2) Step 1
        sqr = sql & "[工作表" & i & "$]" & fin
'        MsgBox sqr
        myrs.Open sqr, myconn
'        MsgBox "工作表資料讀出"
        If (myrs.Fields.Count > 1) Then
'            MsgBox myrs.Fields.Count
            myrs.MoveFirst
            Do While Not myrs.EOF
                Cells(Rows.Count, 1).End(xlUp).Select
                path = Selection.Address
                Range(path).Offset(1, 0).Value = myrs("編號")
                Range(path).Offset(1, 1).Value = myrs("姓名")
                Range(path).Offset(1, 2).Value = DateValue(myrs("生日"))
                Range(path).Offset(1, 3).Value = myrs("血型")
                Range(path).Offset(1, 4).Value = myrs("學歷")
                myrs.MoveNext
            Loop
        End If
        myrs.Close
    Next
 
    myconn.Close
    Set myrs = Nothing
    Set myconn = Nothing
End Sub

Private Sub CommandButton2_Click()
    UserForm7.Show
End Sub

==================

Private Sub CommandButton1_Click()

    Dim id, sql, last As String

    id = TextBox1.Text

    sql = "select * from "

    last = " where 編號 = '" & id & "'"

    Call Sheets(7).browserdata(sql, 1, 4, last)

End Sub

===========================================

Private Sub CommandButton2_Click()

    Dim sql, last As String

    sql = "select * from "

    last = ""

    Call Sheets(7).browserdata(sql, 1, 4, last)

    MsgBox ActiveWorkbook.Worksheets.Count

End Sub

================================

     

1014 從檔案及listbox找出資料並送出列印

Private Sub CommandButton13_Click()
 On Error Resume Next
    Dim sbt As String
 
    sbt = CommandButton13.Caption
    If sbt = "報表4" Then
 
        Set shreport = Worksheets("report")
         
        If shreport Is Nothing Then
            Sheets.Add After:=Sheets(Sheets.Count)   '加在最後面
            Sheets(Sheets.Count).name = "report"
            ActiveWindow.DisplayGridlines = False  '格線取消
         
            '資料輸出從檔案
            Dim con5 As New Ani5
            Dim sql As String
            sql = "select * from scoredata"
            
            Dim kdata
            kdata = con5.dataload(sql, "persondb", "12345678")
         
            Dim listr As Integer
            Dim j As Integer
            listr = UBound(kdata, 1)
            For j = 0 To listr - 1 Step 1
                Cells(j + 1, 1).Value = kdata(j, 0)
                Cells(j + 1, 2).Value = kdata(j, 1)
                Cells(j + 1, 3).Value = kdata(j, 2)
                Cells(j + 1, 4).Value = kdata(j, 3)
                Cells(j + 1, 5).Value = kdata(j, 4)
                Cells(j + 1, 6).Value = kdata(j, 5)
            Next j
            '資料輸出
            UserForm5.Hide
         
            '列印設定
            With ActiveSheet.PageSetup
                .LeftHeader = "&12&""標楷體""北訊電腦資訊中心" '設自型大小 自型 及標題
                .CenterHeader = "成績資料表"
                .RightHeader = "列印日" & "&D"
            End With
         
            With PageSetup
                .LeftFooter = ""
                .CenterFooter = "&p/&n"
                .RightFooter = ""
            End With
         
            Worksheets("report").PrintPreview
            '列印設定
         
            UserForm5.Show vbModeless
         
         
         
        End If
        CommandButton13.Caption = "關閉"
    Else
        'MsgBox "此報表已經存在"
        Application.DisplayAlerts = False
        Sheets("report").Delete
        CommandButton13.Caption = "報表4"
    End If
End Sub
=============================================
Private Sub CommandButton14_Click()
    On Error Resume Next
    Dim sbt As String
 
    sbt = CommandButton14.Caption
    If sbt = "列印輸出" Then
 
        Set shreport = Worksheets("report")
         
        If shreport Is Nothing Then
            Sheets.Add After:=Sheets(Sheets.Count)   '加在最後面
            Sheets(Sheets.Count).name = "report"
            ActiveWindow.DisplayGridlines = False  '格線取消
         
            '資料輸出從listbox
         
            Dim listr As Integer
            Dim j As Integer
            listr = ListBox1.ListCount
            'MsgBox listr
            For j = 0 To listr - 1 Step 1
                Cells(j + 1, 1).Value = ListBox1.List(j, 0)
                Cells(j + 1, 2).Value = ListBox1.List(j, 1)
                Cells(j + 1, 3).Value = ListBox1.List(j, 2)
                Cells(j + 1, 4).Value = ListBox1.List(j, 3)
                Cells(j + 1, 5).Value = ListBox1.List(j, 4)
                Cells(j + 1, 6).Value = ListBox1.List(j, 5)
            Next j
            '資料輸出
            UserForm5.Hide
         
            '列印設定
            With ActiveSheet.PageSetup
                .LeftHeader = "北訊電腦資訊中心"
                .CenterHeader = "成績資料表"
                .RightHeader = "列印日" & "&D"
            End With
         
            With PageSetup
                .LeftFooter = ""
                .CenterFooter = "&p/&n"
                .RightFooter = ""
            End With
         
            Worksheets("report").PrintPreview  '預覽列印
            '列印設定
         
            UserForm5.Show vbModeless
         
         
         
        End If
        CommandButton14.Caption = "關閉"
    Else
        'MsgBox "此報表已經存在"
        Application.DisplayAlerts = False
        Sheets("report").Delete
        CommandButton14.Caption = "列印輸出"
    End If
End Sub
======================
超連結：
1.加入超連結
   Hyperlinks.add  來源資料,目標連結
2.刪除超連結
Hyperlinks.delete
==================================
Private Sub CommandButton1_Click()
    Hyperlinks.Add Cells(1, 1), "http://www.yahoo.com.tw"
End Sub

Private Sub CommandButton2_Click()
    Hyperlinks.Delete
End Sub

Private Sub CommandButton3_Click()
    Dim rcount As Integer
    Dim i As Integer
   
    rcount = UsedRange.Rows.Count
    For i = 1 To rcount Step 1
        Hyperlinks.Add Cells(i, 1), "http://127.0.0.1:80/hope/"
    Next i
   
End Sub

============================

Private Sub CommandButton4_Click()

    Dim cok1 As New Collection

    Dim cok2 As New Collection

    Dim rcount As Integer

    Dim i As Integer

    Dim j As Integer

        

    

    rcount = UsedRange.Rows.Count

    

    For i = 1 To rcount Step 1

        cok1.Add Cells(i, 1)

        cok2.Add Cells(i, 2)

    Next i

    For j = 1 To rcount Step 1

        Hyperlinks.Add Cells(j, 1), "http://127.0.0.1:80/hope/hope01.php?id=" & cok1.Item(j) & "&name=" & cok2.Item(j)

    Next j

End Sub

1012

動態報表查詢系統
1.編號查詢報表
2.姓名查詢報表
3.瀏覽資料報表
4.區間報表
5.日報表
6.月報表
7.季報表
                   sql                              VBA                            printSetup
主表單 ===========database=========報表種類===========列印

sql預存程序
CREATE DEFINER=`root`@`localhost` PROCEDURE `interdata`(IN `id1` VARCHAR(50), IN `id2` VARCHAR(50))
LANGUAGE SQL
NOT DETERMINISTIC
CONTAINS SQL
SQL SECURITY DEFINER
COMMENT ''
BEGIN
select * from scoredata where 學號 between id1 and id2;
END


   Private Sub CommandButton1_Click()
    Dim id1 As String
    Dim id2 As String
 
    If TextBox1.Text <> "" And TextBox2.Text <> "" Then
        id1 = TextBox1.Text
        id2 = TextBox2.Text
     
        sql = "call interdata('" & id1 & "','" & id2 & "')"
        Call UserForm5.loaddata(sql)           '跨表單呼叫
    Else
        MsgBox "請輸入完整資料"
    End If
 
End Sub
=======================================

Private Sub CommandButton10_Click()
On Error Resume Next
    'Dim ws As Worksheet
    'ws.name = "report"
    'Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
    Set shreport = Worksheets("report")
     
    If shreport Is Nothing Then
        Sheets.Add After:=Sheets(Sheets.Count)   '加在最後面
        Sheets(Sheets.Count).name = "report"
    Else
        MsgBox "此報表已經存在"
        Application.DisplayAlerts = False
        Sheets("report").Delete
    End If
End Sub    
===================================
 Private Sub CommandButton11_Click()
On Error Resume Next
    Dim sbt As String
 
    sbt = CommandButton11.Caption
    If sbt = "報表二" Then
 
        Set shreport = Worksheets("report")
         
        If shreport Is Nothing Then
            Sheets.Add After:=Sheets(Sheets.Count)   '加在最後面
            Sheets(Sheets.Count).name = "report"
        End If
        CommandButton11.Caption = "關閉"
    Else
        MsgBox "此報表已經存在"
        Application.DisplayAlerts = False
        Sheets("report").Delete
        CommandButton11.Caption = "報表二"
    End If

End Sub    
               

1007

ddata
CREATE DEFINER=`root`@`localhost` PROCEDURE `ddata`(IN `id` CHAR(50))
LANGUAGE SQL
NOT DETERMINISTIC
CONTAINS SQL
SQL SECURITY DEFINER
COMMENT ''
BEGIN
DELETE FROM scoredata WHERE 學號=id;
END

pname1
CREATE DEFINER=`root`@`localhost` PROCEDURE `pname1`(IN `name` VARCHAR(50))
LANGUAGE SQL
NOT DETERMINISTIC
CONTAINS SQL
SQL SECURITY DEFINER
COMMENT ''
BEGIN
Select * FROM scoredata Where 姓名 LIKE name;
END

udata
CREATE DEFINER=`root`@`localhost` PROCEDURE `udata`(IN `id` VARCHAR(50), IN `name` VARCHAR(50), IN `c1` INT, IN `c2` INT, IN `c3` INT, IN `c4` INT)
LANGUAGE SQL
NOT DETERMINISTIC
CONTAINS SQL
SQL SECURITY DEFINER
COMMENT ''
BEGIN
update scoredata set 姓名=name,國文=c1,英文=c2,數學=c3,地理=c4 where 學號=id;

=======================================================
Private Sub CommandButton6_Click()
    Dim lname As String
    Dim sql As String
   
    If TextBox9.Text <> "" Then
        lname = TextBox9.Text
        sql = "call pname1 ('%" & lname & "%')"
        Call loaddata(sql)
    Else
        MsgBox "請輸入資料"
    End If
End Sub
=============================================
Private Sub CommandButton7_Click()
    Dim com5 As New Ani5
    Dim did As String
    Dim sql As String
   
    If TextBox7.Text <> "" Then
        did = TextBox7.Text
        sql = "call ddata ('" & did & "')"
        com5.modifydata sql:=sql, dn:="persondb", pw:="12345678"
        Call loaddata("select * from dbview1")
    Else
        MsgBox "請先查詢輸入欲刪除資料學號"
    End If
End Sub
==================================================
CREATE PROCEDURE `interdata`(IN `id1` VARCHAR(50), IN `id2` VARCHAR(50))
LANGUAGE SQL
NOT DETERMINISTIC
CONTAINS SQL
SQL SECURITY DEFINER
COMMENT ''
BEGIN
select * from scoredata where 學號 between id1 and id2;
END

1005

Dim p As Boolean

Private Sub CommandButton1_Click()
    If p = False Then
        ListBox1.ListIndex = 0
        Me!ListBox1.Selected(0) = False
        p = True
    End If
 
    Dim com5 As New Ani5
    Dim sql As String
    sql = "select * from scoredata"
 
    Dim kdata
 
    kdata = com5.dataload(sql, "persondb", "12345678")
 
    Dim listr As Integer
    Dim j As Integer
 
    listr = UBound(kdata, 1)
    ListBox1.Clear
     
 
    For j = 0 To listr - 1 Step 1
        ListBox1.AddItem kdata(j, 0)
        ListBox1.List(j, 1) = kdata(j, 1)
        ListBox1.List(j, 2) = kdata(j, 2)
        ListBox1.List(j, 3) = kdata(j, 3)
        ListBox1.List(j, 4) = kdata(j, 4)
        ListBox1.List(j, 5) = kdata(j, 5)
    Next j
 
    If p = True Then
        Me!ListBox1.Selected(0) = True
        ListBox1.SetFocus
        p = False
    End If
     
End Sub

Private Sub CommandButton2_Click()
   'Me!ListBox1.Selected(j) = False
    TextBox1.Text = ""
    TextBox2.Text = ""
    TextBox3.Text = ""
    TextBox4.Text = ""
    TextBox5.Text = ""
    TextBox6.Text = ""
End Sub
=======================
Private Sub ListBox1_Change()
    Dim j As Integer
    j = ListBox1.ListIndex
 
    If p = True Then
        TextBox1.Text = ListBox1.List(j, 0)
        TextBox2.Text = ListBox1.List(j, 1)
        TextBox3.Text = ListBox1.List(j, 2)
        TextBox4.Text = ListBox1.List(j, 3)
        TextBox5.Text = ListBox1.List(j, 4)
        TextBox6.Text = ListBox1.List(j, 5)
    End If
End Sub
Private Sub UserForm_Activate()
   p = True
End Sub
=============================
1.ListBox1_keyDown(byval keycode as MsForms.ReturnInteger,byval shift as integer)
                                                                     回傳整數                              組合鍵

  End Sub
2.ListBox1_keyUp(byval keycode as MsForms.ReturnInteger,byval shift as integer)
                                                                     回傳整數                              組合鍵

  End Sub
* keycode  鍵盤ASCII碼
         上18
左37                右39
          下40
==================================================================
1.ListBox1_Change(): 遮罩變動後立即反應事件
  變動量  change和ListBox1內部是關聯的
2.ListBox1_Click(): mouse點擊ListBox1記錄列所觸發事件  VBA error  
點擊 click和ListBox1內部是關聯的
3.兩者若同時存在已change為優先
===========================================
Dim p As Boolean
Dim p2 As Boolean

Private Sub CommandButton1_Click()
    p2 = False

    If p = False Then
        ListBox1.ListIndex = 0
        Me!ListBox1.Selected(0) = False
        p = True
    End If
 
    Dim com5 As New Ani5
    Dim sql As String
    sql = "select * from scoredata"
 
    Dim kdata
 
    kdata = com5.dataload(sql, "persondb", "12345678")
 
    Dim listr As Integer
    Dim j As Integer
 
    listr = UBound(kdata, 1)
    ListBox1.Clear
     
 
    For j = 0 To listr - 1 Step 1
        ListBox1.AddItem kdata(j, 0)
        ListBox1.List(j, 1) = kdata(j, 1)
        ListBox1.List(j, 2) = kdata(j, 2)
        ListBox1.List(j, 3) = kdata(j, 3)
        ListBox1.List(j, 4) = kdata(j, 4)
        ListBox1.List(j, 5) = kdata(j, 5)
    Next j
 
    If p = True Then
        Me!ListBox1.Selected(0) = True
        ListBox1.SetFocus
        p = False
    End If
     
End Sub

Private Sub CommandButton2_Click()
   'Me!ListBox1.Selected(j) = False
    TextBox1.Text = ""
    TextBox2.Text = ""
    TextBox3.Text = ""
    TextBox4.Text = ""
    TextBox5.Text = ""
    TextBox6.Text = ""
End Sub

=============

Private Sub ListBox1_Change()

    Dim j As Integer

    j = ListBox1.ListIndex

    

    If p = True Then

        TextBox1.Text = ListBox1.List(j, 0)

        TextBox2.Text = ListBox1.List(j, 1)

        TextBox3.Text = ListBox1.List(j, 2)

        TextBox4.Text = ListBox1.List(j, 3)

        TextBox5.Text = ListBox1.List(j, 4)

        TextBox6.Text = ListBox1.List(j, 5)

    End If

    

    If p2 = True Then

        TextBox1.Text = ListBox1.List(j, 0)

        TextBox2.Text = ListBox1.List(j, 1)

        TextBox3.Text = ListBox1.List(j, 2)

        TextBox4.Text = ListBox1.List(j, 3)

        TextBox5.Text = ListBox1.List(j, 4)

        TextBox6.Text = ListBox1.List(j, 5)

    End If

End Sub

====================

Private Sub ListBox1_Click()

   Dim j As Integer

   j = ListBox1.ListIndex

   TextBox1.Text = ListBox1.List(j, 0)

   TextBox2.Text = ListBox1.List(j, 1)

   TextBox3.Text = ListBox1.List(j, 2)

   TextBox4.Text = ListBox1.List(j, 3)

   TextBox5.Text = ListBox1.List(j, 4)

   TextBox6.Text = ListBox1.List(j, 5)

End Sub

==========================================

Private Sub ListBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

    If KeyCode = 38 Then

        p2 = True

    End If

    

    If KeyCode = 40 Then

        p2 = True

    End If

End Sub

Private Sub UserForm_Activate()

   p = True

   p2 = False

End Sub

======================

查詢
1.sql直接寫在表單
2.sql 語法寫在資料庫管理介面，而不寫在表單，為了網路安全保護資料庫

CREATE PROCEDURE `pid2`(IN `id` VARCHAR(50))
LANGUAGE SQL
NOT DETERMINISTIC
CONTAINS SQL
SQL SECURITY DEFINER
COMMENT ''
BEGIN
select * from scoredata where 學號=id;
END

CREATE PROCEDURE `pname`(IN `name` VARCHAR(50))
LANGUAGE SQL
NOT DETERMINISTIC
CONTAINS SQL
SQL SECURITY DEFINER
COMMENT ''
BEGIN
select * from scoredata where 姓名=name;
END
=======================================

Dim p As Boolean
Dim p2 As Boolean

Private Sub CommandButton1_Click()
    Dim sql As String
    sql = "select * from scoredata"
    Call loaddata(sql)
End Sub

Private Sub CommandButton2_Click()
   'Me!ListBox1.Selected(j) = False
    TextBox1.Text = ""
    TextBox2.Text = ""
    TextBox3.Text = ""
    TextBox4.Text = ""
    TextBox5.Text = ""
    TextBox6.Text = ""
End Sub

Private Sub CommandButton3_Click()
    On Error GoTo la1
    Dim com5 As New Ani5
    Dim sql As String
    Dim no, name As String
    Dim c1, c2, c3, c4 As Integer
 
    no = TextBox1.Text
    name = TextBox2.Text
    c1 = CInt(TextBox3.Text)
    c2 = CInt(TextBox4.Text)
    c3 = CInt(TextBox5.Text)
    c4 = CInt(TextBox6.Text)
 
    sql = "insert into scoredata values('" & no & "','" & name & "'," & c1 & "," & c2 & "," & c3 & "," & c4 & ")"
    com5.modifydata sql:=sql, dn:="persondb", pw:="12345678"
    Exit Sub
la1:
    MsgBox "學號不可重複或資料不完整"
End Sub
Sub loaddata(ByVal sql As String)
    p2 = False

    If p = False Then
        ListBox1.ListIndex = 0
        Me!ListBox1.Selected(0) = False
        p = True
    End If
 
    Dim com5 As New Ani5
    'Dim sql As String
 
    'sql = "select * from scoredata"
    Dim kdata
 
    kdata = com5.dataload(sql, "persondb", "12345678")
 
    Dim listr As Integer
    Dim j As Integer
 
    listr = UBound(kdata, 1)
    ListBox1.Clear
     
 
    For j = 0 To listr - 1 Step 1
        ListBox1.AddItem kdata(j, 0)
        ListBox1.List(j, 1) = kdata(j, 1)
        ListBox1.List(j, 2) = kdata(j, 2)
        ListBox1.List(j, 3) = kdata(j, 3)
        ListBox1.List(j, 4) = kdata(j, 4)
        ListBox1.List(j, 5) = kdata(j, 5)
    Next j
 
    If p = True Then
        Me!ListBox1.Selected(0) = True
        ListBox1.SetFocus
        p = False
    End If
     
End Sub
Private Sub CommandButton4_Click()
    Dim id As String
    Dim sql As String
 
    If TextBox7.Text <> "" Then
        id = TextBox7.Text
        sql = "call pid2 ('" & id & "')"
        Call loaddata(sql)
    Else
        MsgBox "請輸入學號資料"
    End If
 
End Sub

Private Sub CommandButton5_Click()
    Dim name As String
    Dim sql As String
 
    If TextBox8.Text <> "" Then
        name = TextBox8.Text
        sql = "call pname ('" & name & "')"
        Call loaddata(sql)
    Else
        MsgBox "請輸入姓名資料"
    End If
End Sub

Private Sub ListBox1_Change()
    Dim j As Integer
    j = ListBox1.ListIndex
 
    If p = True Then
        TextBox1.Text = ListBox1.List(j, 0)
        TextBox2.Text = ListBox1.List(j, 1)
        TextBox3.Text = ListBox1.List(j, 2)
        TextBox4.Text = ListBox1.List(j, 3)
        TextBox5.Text = ListBox1.List(j, 4)
        TextBox6.Text = ListBox1.List(j, 5)
    End If
 
    If p2 = True Then
        TextBox1.Text = ListBox1.List(j, 0)
        TextBox2.Text = ListBox1.List(j, 1)
        TextBox3.Text = ListBox1.List(j, 2)
        TextBox4.Text = ListBox1.List(j, 3)
        TextBox5.Text = ListBox1.List(j, 4)
        TextBox6.Text = ListBox1.List(j, 5)
    End If
End Sub

Private Sub ListBox1_Click()
   Dim j As Integer
   j = ListBox1.ListIndex
   TextBox1.Text = ListBox1.List(j, 0)
   TextBox2.Text = ListBox1.List(j, 1)
   TextBox3.Text = ListBox1.List(j, 2)
   TextBox4.Text = ListBox1.List(j, 3)
   TextBox5.Text = ListBox1.List(j, 4)
   TextBox6.Text = ListBox1.List(j, 5)
End Sub

Private Sub ListBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 38 Then
        p2 = True
    End If
 
    If KeyCode = 40 Then
        p2 = True
    End If
End Sub

Private Sub UserForm_Activate()
   p = True
   p2 = False
End Sub

1003

https://msdn.microsoft.com/en-us/library/office/ff845049.aspx

Private Sub CommandButton3_Click()
    On Error GoTo la1
    Dim com5 As New Ani5
    Dim sql As String
    Dim no, name As String
    Dim c1, c2, c3, c4 As Integer
   
    no = TextBox1.Text
    name = TextBox2.Text
    c1 = CInt(TextBox3.Text)
    c2 = CInt(TextBox4.Text)
    c3 = CInt(TextBox5.Text)
    c4 = CInt(TextBox6.Text)
   
    sql = "insert into scoredata values('" & no & "','" & name & "'," & c1 & "," & c2 & "," & c3 & "," & c4 & ")"
    com5.modifydata sql:=sql, dn:="persondb", pw:="12345678"
    Exit Sub
la1:
    MsgBox "學號不可重複或資料不完整"
End Sub
======================================================
Public Function modifydata(ByVal sql As String, ByVal dn As String, ByVal pw As String)
    Dim conn As New ADODB.Connection  '資料庫連線
    Dim rs As New ADODB.Recordset     '資料集
   
    ConnectionString = "driver={mysql odbc 5.1 driver};database=" & dn & ";server=127.0.0.1;port=3306;uid=root;password=" & pw & ";opt=3;smt=SET NAMES 'gb2312'"
    conn.Open ConnectionString
    rs.Open sql, conn
   
    MsgBox "功能執行完成"
    conn.Close
   
    Set rs = Nothing
    Set conn = Nothing
End Function

=====================================