On Error Resume Next '此句必须有，防止无EXCEL进程时GetObject出错退出
dim myfile,xlapp,xlbook
Set MyFile = fso.GetFile("d:\"&date&".xls")
Set xlapp=CreateObject("Excel.Application") '创建Excel应用程序对象
Set xlbook=xlapp.Workbooks.Open("d:\"&date&".xls") '打开指定的文件
If IsEmpty(xlbook) then '如果xlbook对象为空
msgbox("没有找到")
Set xlbook=xlapp.Workbooks.Add ' 新建工作簿
xlbook.SaveAs ("d:\"&date&".xls") ' 新工作薄保存为指定文件名
msgbox("新建工作簿")
End if
xlapp.ActiveWorkbook.Save
xlapp.Workbooks.Close
xlapp.Quit