业主提出月报表要求，需要将每天的出料量每天记录一次，然后每月自动形成月报表，之前弄过日报表，由于没有学过VBS，对于日报表也只是勉强能看懂，知道如何改变量数据库名这些，最基本的。

这两天用日报表的脚本改造了个月报表，脚本如下：

Option Explicit

Function action

Dim sPro

Dim sDsn

Dim sSer

Dim sCon

Dim sSql, sSql1,sSql2,sSql3,sSql4,sSql5

Dim oRs,oRs1,oRs2,oRs3,oRs4,oRs5

Dim conn

Dim oCom,oCom1,oCom2,oCom3,oCom4,oCom5

Dim n,k,l

Dim objExcelApp,i,j

Dim fso,myfile,fname

Dim StrBtime,StrEtime

Dim atime,new1Btime,newBtime,newEtime

Set fso=CreateObject("Scripting.FileSystemObject")

Set myfile=fso.GetFile("D:出料量报表系统报表Fixreports2.xlsx")

fname="D:出料量报表系统月报表"& FormatDateTime(Date,2) & ".xlsx"

'fname="D:报表系统日报表"& FormatDateTime(Date,2) & " " & Hour(Time) &"-00-00.xls"

MyFile.Copy(fname)

On Error Resume Next 

Dim ExcelApp,ExcelBook 

Set ExcelApp  = GetObject(,"Excel.Application") 

If TypeName(ExcleApp) = "Application" Then 

For Each ExcelBook In ExcelApp.WorkBooks 

  If ExcelBook.FullName = myfile Then 

     ExcelApp.Workbooks.Close 

     ExcelApp.Quit 

     Set ExcelApp= Nothing 

     Exit For 

  End If 

     Next 

End If 

Set objExcelApp=CreateObject("Excel.Application")

objExcelApp.workbooks.open fname

atime=FormatDateTime(Now(),vbGeneralDate)

newEtime=DateAdd("m",-0,atime)

newBtime=DateAdd("m",-1,atime)

StrBtime=CStr(newBtime)

StrEtime=CStr(newEtime)

sPro = "Provider=WinCCOLEDBProvider.1;"

sDsn = "Catalog=CC_shandong_17_12_24_09_57_12R;"

sSer = "Data Source=.WinCC"

sCon = sPro + sDsn + sSer

sSql = "TAG:R,'chuliaoliang
#chuliaoliangzong','"+StrBtime+"','"+StrEtime+"'"

sSql1 = "TAG:R,'chuliaoliang#chuliaoliangzong','"+StrBtime+"','"+StrEtime+"'"

sSql2 = "TAG:R,'chuliaoliang#chuliaoliangzong','"+StrBtime+"','"+StrEtime+"'"

sSql3 = "TAG:R,'chuliaoliang#chuliaoliangzong','"+StrBtime+"','"+StrEtime+"'"

sSql4 = "TAG:R,'chuliaoliang#chuliaoliangzong','"+StrBtime+"','"+StrEtime+"'"

sSql5 = "TAG:R,'chuliaoliangchuliaoliangzong','"+StrBtime+"','"+StrEtime+"'"

Set conn = CreateObject("ADODB.Connection")

conn.ConnectionString = sCon

conn.CursorLocation = 3

conn.Open

Set oRs = CreateObject("ADODB.Recordset")

Set oRs1 = CreateObject("ADODB.Recordset")

Set oRs2 = CreateObject("ADODB.Recordset")

Set oRs3 = CreateObject("ADODB.Recordset")

Set oRs4 = CreateObject("ADODB.Recordset")

Set oRs5 = CreateObject("ADODB.Recordset")

Set oCom = CreateObject("ADODB.Command")

oCom.CommandType = 1

Set oCom.ActiveConnection = conn

oCom.CommandText = sSql

Set oRs = oCom.Execute

Set oCom1 = CreateObject("ADODB.Command")

oCom1.CommandType = 1

Set oCom1.ActiveConnection = conn

oCom1.CommandText = sSql1

Set oRs1 = oCom1.Execute

Set oCom2 = CreateObject("ADODB.Command")

oCom2.CommandType = 1

Set oCom2.ActiveConnection = conn

oCom2.CommandText = sSql2

Set oRs2 = oCom2.Execute

Set oCom3 = CreateObject("ADODB.Command")

oCom3.CommandType = 1

Set oCom3.ActiveConnection = conn

oCom3.CommandText = sSql3

Set oRs3 = oCom3.Execute

Set oCom4 = CreateObject("ADODB.Command")

oCom4.CommandType = 1

Set oCom4.ActiveConnection = conn

oCom4.CommandText = sSql4

Set oRs4= oCom4.Execute

Set oCom5 = CreateObject("ADODB.Command")

oCom5.CommandType = 1

Set oCom5.ActiveConnection = conn

oCom5.CommandText = sSql5

Set oRs5 = oCom5.Execute

m = oRs.Fields.Count

    If (m > 0 ) Then 

         oRs.MoveFirst

         oRs1.MoveFirst

         oRs2.MoveFirst

         oRs3.MoveFirst

         oRs4.MoveFirst

         oRs5.MoveFirst

         n = 0

         Do While Not oRs1.EOF 

         l= CDate(oRs1.Fields(1).value)

         k = DateAdd("h", 8, l)

         objExcelApp.Worksheets("数据报表").cells(n+5,1).value=k

         objExcelApp.Cells(n+5,1).ColumnWidth =40

         objExcelApp.Worksheets("数据报表").cells(n+5,2).value=FormatNumber(oRs.Fields(2).value,2)

         objExcelApp.Cells(n+5,2).ColumnWidth =20

         objExcelApp.Worksheets("数据报表").cells(n+5,3).value=FormatNumber(oRs1.Fields(2).value,2) 

         objExcelApp.Cells(n+5,3).ColumnWidth =20

         objExcelApp.Worksheets("数据报表").cells(n+5,4).value =FormatNumber(oRs2.Fields(2).value,2)

         objExcelApp.Cells(n+5,4).ColumnWidth =20

         objExcelApp.Worksheets("数据报表").cells(n+5,5).value =FormatNumber(oRs3.Fields(2).value,2) 

         objExcelApp.Cells(n+5,5).ColumnWidth =20

         objExcelApp.Worksheets("数据报表").cells(n+5,6).value =FormatNumber(oRs4.Fields(2).value,2)

         objExcelApp.Cells(n+5,6).ColumnWidth =20

         objExcelApp.Worksheets("数据报表").cells(n+5,7).value = FormatNumber(oRs5.Fields(2).value,2)

         objExcelApp.Cells(n+5,7).ColumnWidth =20

          n = n + 1

          oRs.MoveNext

          On Error Resume Next

          oRs1.MoveNext

           On Error Resume Next

          oRs2.MoveNext

           On Error Resume Next

          oRs3.MoveNext

           On Error Resume Next

          oRs4.MoveNext

           On Error Resume Next

          oRs5.MoveNext

           On Error Resume Next

          Loop

oRs.Close

Set oRs = Nothing

oRs1.Close

Set oRs1 = Nothing

oRs2.Close

Set oRs2 = Nothing

oRs3.Close

Set oRs3 = Nothing

oRs4.Close

Set oRs4 = Nothing

oRs5.Close

Set oRs5 = Nothing

conn.Close

Set conn = Nothing

objExcelApp.ActiveWorkbook.Save

objExcelApp.Workbooks.Close

objExcelApp.Quit

Set objExcelApp = Nothing

Else 

objExcelApp.Workbooks.Close

objExcelApp.Quit

MsgBox"查询数据为空，请修改查询条件！" 

End If

End Function

脚本中的变量是每天0：03由程序中点控制归档，现在归档都正常，然后每月1号程序中做了个点，用于触发全局脚本，自动形成EXCEL，经测试以上脚本能实现将上月的数据导入到EXCEL中，但没有1号和2号的数据，小弟实在不知道为啥了，脚本哪里有错误，由于对VBS不是很了解，能力有限，望各位大侠赐教，万分感谢！！！