' Macro1 Macro
'
' 快捷键: Ctrl+p
'
Dim zz_date As String * 8, zz_year As String * 4, zz_month As String * 2, zz_day As String * 2
Dim shopid As String * 4, fName As String, curPath As String, endRows As Integer
'把当前日期按yyyymmdd格式赋值给zz_date变量
zz_year = Year(Now())
zz_month = Month(Now())
zz_day = Day(Now())
If Len(RTrim(zz_month)) = 1 Then zz_month = "0" & RTrim(zz_month)
If Len(RTrim(zz_day)) = 1 Then zz_day = "0" & RTrim(zz_day)
zz_date = zz_year & zz_month & zz_day
'清空数据表
Sheets("sheet1").Select
Cells.Clear
Dim strConn As String, strSQL As String
Dim conn As ADODB.Connection
Dim ds As ADODB.Recordset
Dim col As Integer
curPath = ActiveWorkbook.Path
'连接数据库的字符串
strConn = "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=sa;Password=sql;Initial Catalog=hyreport;Data Source=10.2.0.1;Connect Timeout=720; "
'查询语句
strSQL = "select * from Hy_KPI_Shop_Dept_WeekRpt order by 店铺代码,课类编码 "
Set conn = New ADODB.Connection
Set ds = New ADODB.Recordset
'打开数据库连接
conn.Open strConn
https://www.doczj.com/doc/c24890905.html,mandTimeout = 720
With ds
'根据查询语句获得数据
.Open strSQL, conn
'自动控制加入所有列标题
For col = 0 To ds.Fields.Count - 1
'请注意Offset(0, col)中的参数一定要正确
Worksheets("sheet1").Range("A1").Offset(0, col).Value = ds.Fields(col).Name
Next
'加入所有行数据
Worksheets("sheet1").Range("A1").Offset(1, 0).CopyFromRecordset ds
End With
'关闭数据库连接和清空资源
Set ds = Nothing
conn.Close
Set conn = Nothing
'中间数据处理过程略
'然后执行自动筛选
Cells.Select
Selection.AutoFilter
'取shopid值并导入到各个文件中
Worksheets("shopid").Activate
ActiveSheet.Range("A50").Select
Do While (ActiveCell.Value <> "")
shopid = ActiveCell.Value
fName = shopid & "周报" & zz_date & ".xls"
If Dir(curPath & "\" & shopid, vbDirectory) = vbNullString Then
ChDir curPath
MkDir curPath & "\" & shopid
End If
Workbooks.Add
ActiveSheet.Cells.Select
Selection.Interior.ColorIndex = 2
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=curPath & "\" & shopid & "\" & fName, FileFormat:=xlExcel7
Workbooks("门店周报.xls").Worksheets("sheet1").Activate
Selection.AutoFilter Field:=1, Criteria1:=shopid
ActiveSheet.Rows("1:1").Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows(fName).Activate
Sheets("Sheet1").Range("A1:A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
Workbooks("门店周报.XLS").Worksheet
s("shopid").Activate
Cells(ActiveCell.Row + 1, 1).Select
Loop
'撤销自动筛选
Workbooks("门店周报.xls").Worksheets("sheet1").Activate
Selection.AutoFilter
'----------保存全部到总表----
Dim B00B As String
Worksheets("shopid").Activate
ActiveSheet.Range("A49").Select
B00B = ActiveCell.Value
fName = B00B & "周报总表" & zz_date & ".xls"
If Dir(curPath & "\" & B00B, vbDirectory) = vbNullString Then
ChDir curPath
MkDir curPath & "\" & B00B
End If
Workbooks.Add
ActiveSheet.Cells.Select
Selection.Interior.ColorIndex = 2
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=curPath & "\" & B00B & "\" & fName, FileFormat:=xlExcel12
Workbooks("门店周报.xls").Worksheets("sheet1").Activate
ActiveSheet.Rows("1:1").Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows(fName).Activate
Sheets("Sheet1").Range("A1:A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
Workbooks("门店周报.xls").Worksheets("sheet1").Activate
'Windows("门店周报.xls").Activate
ActiveWindow.Close
End