2016年10月19日 星期三

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
================================
     

沒有留言:

張貼留言