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

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

0930

進階資料庫語言
1.視圖
2.預存程序
3.預存函數
4.觸發器
5.指標 存儲過程用
6.事件

視圖 view  HeidiSQL_9.3_Portable
預存程序

Public Function dataload(ByVal sql As String, ByVal dbname As String, ByVal pw As String) As String()
    Dim conn As New ADODB.Connection  '資料庫連線
    Dim rs As New ADODB.Recordset     '資料集
   
    ConnectionString = "driver={mysql odbc 5.1 driver};database=" & dbname & ";server=127.0.0.1;port=3306;uid=root;password=" & pw & ";opt=3;smt=SET NAMES 'gb2312'"
    conn.Open ConnectionString
    rs.Open sql, conn
           
    Dim r As Integer
    Dim f As Integer
    rs.MoveFirst
    Do While Not rs.EOF
       r = r + 1       '取得總計錄數
       rs.MoveNext
    Loop
    f = rs.Fields.Count  '取得總欄位數
   
    ReDim kdata(r, f) As String  '設定二維動態陣列
   
    Dim p As Integer
    Dim i As Integer
    p = 0
    rs.MoveFirst
    Do While Not rs.EOF
       For i = 0 To f - 1 Step 1
        kdata(p, i) = rs(i)
       Next
       p = p + 1
       rs.MoveNext
    Loop
       rs.Close
       conn.Close
     
       dataload = kdata
     
End Function
======================================
Private Sub CommandButton1_Click()
    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
       
End Sub