从数据透视图中导出报表其中一个条件需要从数据库中获取,采用vbs获取数据库,然后查找记录。之前学过vb获取数据库这次改成vbs获取方式也差不多。
Dim DB Dim isSQL Dim userKey Dim userName Dim ouInfo Dim i
Dim plantKey(4) Dim plantId(4)
Set DB = CreateObject("ADODB.Connection") Set objRecordSet = CreateObject("ADODB.RECORDSET") i = 0 DB.Open "Driver=SQL Server;server=hqdemo1\MSSQLSERVER1;Database=CADB;uid=sa;pwd=filenet;" DB.Execute("select * from EX_DMOrg") isSQL = "select DMUser_key,userName from EX_DMOrg where OrgLevel='1'" Set objRecordSet = DB.Execute(isSQL) Do Until objRecordSet.EOF userKey = objRecordSet("DMUser_key") userName = objRecordSet("userName") ouInfo = Split(userName,",")(0) plantKey(i) = userKey plantId(i)= Mid(ouInfo,4) i = i +1 WScript.Echo objRecordSet.MoveNext Loop
server 是目标服务器,Database是数据库名称,uid则是登录名,pwd当然就是密码了。
比较简单不过vbs还是经常用到的,下面的则是vbs导出excel的代码
Sub excel_gen(pPath,sFilename,psheet,pchart,picRange,pdate_y,pdate_m,savePath,param_pt,param_pt2,param_pf,param_cpn,fileType,chartNum,chartType,chartName) dim tempPath Dim oExcel,oWb,oSheet Dim Newshape Dim sheetField Dim chartField Set oExcel = CreateObject("Excel.Application") oExcel.Visible = False On Error Resume Next '动态设置文件名 '存储路径 If pdate_y = "" then savePath=savePath & mid(pPath,4,InStr(4,pPath,"BPM")) & MyArray(3) & "\" Elseif pdate_m = "" Then if sFilename = paFile(5) then savePath=savePath & mid(pPath,4) & MyArray(3) & "\" & pdate_y & "\" else savePath=savePath & mid(pPath,4,InStr(4,pPath,"BPM")-4) & MyArray(3) & "\" & pdate_y & "\" & mid(pPath,InStr(4,pPath,"BPM")) End if else savePath=savePath & mid(pPath,4) & MyArray(3) & "\" & pdate_y & "\" & pdate_m & "\" end if Wscript.Echo "savePath " & savePath Set oWb = oExcel.WorkBooks.Open(pPath & sFilename) Set oSheet = oWb.Sheets(psheet) oSheet.select If sFilename <> paFile(4) Then oSheet.PivotTables(param_pt).PivotFields("[Org User].[Parent Key].[Level 02]").VisibleItemsList = Array("[Org User].[Parent Key].&["& MyArray(4) &"]") End if Select Case fileType case 1 oSheet.PivotTables(param_pt).PivotFields(param_pf).ClearAllFilters oSheet.PivotTables(param_pt).PivotFields(param_pf).CurrentPageName = param_cpn case 2 oSheet.PivotTables(param_pt).PivotFields(param_pf).ClearAllFilters ' oSheet.PivotTables(param_pt).PivotFields(param_pf).CurrentPageName = param_cpn oSheet.PivotTables(param_pt).PivotFields(param_pf).VisibleItemsList = Array(param_cpn) end Select if err.number<>0 Then Wscript.Echo err.description oExcel.ActiveWorkBook.Saved = True oWb.Close() wscript.quit err.clear Exit Sub End If Set fs = CreateObject("Scripting.FileSystemObject") if(fs.FolderExists(savePath))then Wscript.Echo savePath & "exist" else Dim WshShell Set WshShell = CreateObject("wscript.Shell") WshShell.Run "cmd.exe /c md " & savePath end if If fs.FileExists(savePath & sFilename) Then fs.DeleteFile(savePath & sFilename) WScript.Echo "delete exit file" End If oSheet.UsedRange.Select oSheet.UsedRange.Copy '生成Excel表 Wscript.Echo "生成Excel表中,请稍候..." Set ExcelApp =CreateObject("Excel.Application") '创建EXCEL对象 Set ExcelBook =ExcelApp.Workbooks.Add Set ExcelSheet = ExcelBook.Worksheets(1)'添加工作页 ExcelSheet.Activate 'ExcelApp.DisplayAlerts = False ExcelSheet.Name="sheet1" ExcelSheet.paste ExcelBook.SaveAs savePath & sFilename'保存工作表 Wscript.Echo sFilename & "导出表创建成功!保存在" & savePath ExcelBook.Close set excelApp=nothing set ExcelBook=nothing set ExcelSheet=nothing on error goto 0 oExcel.ActiveWorkBook.Saved = True oExcel.CutCopyMode =False oWb.Close() WScript.Echo "该文件操作完成" End Sub
其中参数说明:dim pPath '文件路径 dim sFilename '文件名 dim psheet '要保存的sheet,表单所在sheet的name dim pchart '要保存的chart,chart所在sheet/chart的name dim picRange '保存区域,暂不用 dim pdate_y '操作日期 年 dim pdate_m '操作日期 月 dim param_pt '透视表名称 dim param_pt2 '透视表名称2 * 部分报表两张透视表 dim param_pf '透视域 dim param_cpn '当前PageName dim savePath '存放路径
case 1 是选取维度单一的情况,比如某个月。case 2 则是选择维度是多个情况,按年份来查看月度情况。vbs导出excel通过上面的方法就可以导出,也可以把excel导成图片的格式。