【excel宏】从sqlserver拷贝数据到excel

首先在excel中设置 工具——宏——安全性——低

然后在调试窗口中  工具——引用：microsoft   activex   data  objects  和 microsoft   activex   data  objects recordset

 

Sub SQLSERVER_EXCEL()

Dim conn As Connection
Dim rs As Recordset
Dim Workbook As String
Workbook = "清单数据_版纳.xls"
Dim str_areacode  As String
str_areacode = Worksheets("首页").Cells(1, 1)
Dim str_start   As String
str_start = Worksheets("首页").Cells(1, 3)
Dim str_end   As String
str_end = Worksheets("首页").Cells(1, 4)

 

Set conn = New Connection
conn.Open "PROVIDER=SQLOLEDB;DATA SOURCE=135.35.6.172;User ID=sa;Password=1;DataBase=REPORT"

Set rs = New Recordset
rs.Open " SELECT  top 100 NUM,STAT_DATE,ORD_NO,LEVEL0_DSC,PROD_NAME,STRATE_GROUP,BUREAU_NAME FROM QUERY_DETAIL_RPT_MID_FACT_PROD_SERV_SL WHERE AREA_CODE='" + str_areacode + "' AND STAT_DATE>=CONVERT(DATETIME,'" + str_start + "')  and STAT_DATE<CONVERT(DATETIME,'" + str_end + "')", conn, adOpenForwardOnly, adLockReadOnly

  Workbooks(Workbook).Worksheets("受理清单").Select
  Range("A1:AZ65536").ClearContents
  Cells(1, 1).Value = "接入号码"
  Cells(1, 2).Value = "受理日期"
  Cells(1, 3).Value = "工单号"
  Cells(1, 4).Value = "产品分类"
  Cells(1, 5).Value = "产品名称"
  Cells(1, 6).Value = "战略分群"
  Cells(1, 7).Value = "区县"
 
  Range("A2").CopyFromRecordset rs
  rs.Close
  Selection.Copy
  ActiveWorkbook.ActiveSheet.Paste
 

Set rs = New Recordset
rs.Open " SELECT  top 100 NUM,STAT_DATE,ORD_NO,LEVEL0_DSC,PROD_NAME,STRATE_GROUP,BUREAU_NAME FROM QUERY_DETAIL_RPT_MID_FACT_PROD_SERV_JG WHERE AREA_CODE='" + str_areacode + "' AND STAT_DATE>=CONVERT(DATETIME,'" + str_start + "')  and STAT_DATE<CONVERT(DATETIME,'" + str_end + "')", conn, adOpenForwardOnly, adLockReadOnly

  Workbooks(Workbook).Worksheets("竣工清单").Select
  Range("A1:AZ65536").ClearContents
  Cells(1, 1).Value = "接入号码"
  Cells(1, 2).Value = "竣工日期"
  Cells(1, 3).Value = "工单号"
  Cells(1, 4).Value = "产品分类"
  Cells(1, 5).Value = "产品名称"
  Cells(1, 6).Value = "战略分群"
  Cells(1, 7).Value = "区县"
 
  Range("A2").CopyFromRecordset rs
  rs.Close
  Selection.Copy
  ActiveWorkbook.ActiveSheet.Paste
 
   
conn.Close
Set rs = Nothing
Set conn = Nothing
End Sub