麻辣家族討論版版 - Powered by Discuz! Board

Private Sub CommandButton2_Click()
'定義部份
Dim cn As ADODB.Connection 'Excel連接
Dim rs As ADODB.Recordset '得來的結果,會放到立這個rs的地方.
Dim strDataSrcXlsPath As String '數據庫EXCEL位置
Dim strQuery As String '用作拿數據的SQL
Dim strStartlocation As String '定義得來數據,放到那一個位置.
'I) 以下建立數據庫連接
strDataSrcXlsPath = ThisWorkbook.Path & "\資料.xlsx" '定立數據庫EXCEL位置
Set cn = New ADODB.Connection
With cn
'確定連接所用的Library
.Provider = "Microsoft.ACE.OLEDB.12.0"
.CursorLocation = adUseClient
'把連接指向指定Excel
'xtended properties為excel的版本, 通常為12 或 8,
'12為2007Excel檔(如XLSX,XLSM). 8可相容1997-2003等excel(XLS)
.ConnectionString = "Data Source=" & strDataSrcXlsPath & _
";Extended Properties=Excel 12.0;"
'開始連接,這個時候ACE會打開excel
.Open
End With
'II) 以下運行SQL和回傳數據
'拿出一行資料,所用SQL架構大約為
'SELECT ... FROM ... WHERE
'
'SELECT 上的 * 用作指明拿出所有表上的欄位
'TOP 50 是指抽出頭50列數據
'
'FROM 從DATASHEET工作表抽出
'strQuery = "SELECT top 10 * FROM [總表$]"
strQuery = "SELECT 站別分析,類別,月份,日期,SUM(產出數) AS 總數 " & _
"FROM [總表$] " & _
"where 日期 between #2018/9/1# and #2018/9/30# " & _
"GROUP BY 站別分析,類別,月份,日期 HAVING 類別='305AS'" & _
"ORDER BY 站別分析,日期"
'strQuery = "SELECT 日期 " & _
"FROM [總表$] " & _
"where 日期 between #2018/9/1# and #2018/9/30# " 'HAVING 類別='305AS'"
Set rs = cn.Execute(strQuery) '執行SQL
'III) 把數據抄至所需的位置
strStartlocation = "A1"
'III-1 把欄位名稱一個一地拿出
'rs.Fields.Count : 欄位數數
'rs.Fields(n).Name : 欄名
Dim lngColCounter As Long
i = -1
For lngColCounter = 0 To rs.Fields.Count - 1
Range(strStartlocation).Offset(0, lngColCounter) = rs.Fields(lngColCounter).Name
Next lngColCounter
'III-2 把數據庫資料列表拿出
ActiveSheet.Range(strStartlocation).Offset(1, 0).CopyFromRecordset rs
'IV) 關掉/清理連接
cn.Close
Set cn = Nothing
Set rs = Nothing
End Sub

複製代碼