Dim strConn As String, strSQL As String
  Dim conn As ADODB.Connection
  Dim ds As ADODB.Recordset
  Dim col As Integer
 
  '連接數(shù)據(jù)庫(kù)的字符串
  strConn = "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=[user];Password=[password];Initial Catalog=[database];Data Source=[數(shù)據(jù)庫(kù)IP地址或數(shù)據(jù)庫(kù)服務(wù)器名稱];Connect Timeout=720; "
 
  '查詢語(yǔ)句，如果sql語(yǔ)句很長(zhǎng)可以用strSQL=strSQL+來(lái)連接分成多段的語(yǔ)句，如果語(yǔ)句很短可以只寫(xiě)在一行上。
   strSQL = "select * from Hy_KPI_Shop_Dept_WeekRpt "
   strSQL = strSQL+"where sdate='2014-01-01' order by sdate,shopid "
 
   Set conn = New ADODB.Connection
   Set ds = New ADODB.Recordset
 
  '打開(kāi)數(shù)據(jù)庫(kù)連接
   conn.Open strConn
 
  '該句和數(shù)據(jù)庫(kù)連接字符串處的Connect Timeout=720，表示說(shuō)如果語(yǔ)句運(yùn)行時(shí)間很長(zhǎng)，這兩句可以延長(zhǎng)vba的等待時(shí)間，沒(méi)有這兩句，vba往往會(huì)報(bào)查詢超時(shí)。
   conn.CommandTimeout = 720
 
 
   With ds
  '根據(jù)查詢語(yǔ)句獲得數(shù)據(jù)
     .Open strSQL, conn
     '自動(dòng)控制加入所有列標(biāo)題
     For col = 0 To ds.Fields.Count - 1
 
  '請(qǐng)注意Offset(0, col)中的參數(shù)一定要正確，該句表示標(biāo)題將會(huì)寫(xiě)在第一行，從A1單元格開(kāi)始，如果不想寫(xiě)入標(biāo)題行，可將下面這句注釋掉。
   Worksheets("門(mén)店各課KPI周報(bào)").Range("A1").Offset(0, col).Value = ds.Fields(col).Name
     Next
 
  '加入所有行數(shù)據(jù)，該句表示查詢結(jié)果將會(huì)寫(xiě)在第一行，從A1單元格開(kāi)始，但是由于標(biāo)題行寫(xiě)在第一行了，所以實(shí)際這一行從標(biāo)題下的一行寫(xiě)入。
   Worksheets("sheet1").Range("A1").Offset(1, 0).CopyFromRecordset ds
   End With
  '關(guān)閉數(shù)據(jù)庫(kù)連接和清空資源
   Set ds = Nothing
   conn.Close
   Set conn = Nothing