<% 'EXCEL Dim xls, I, J, tempName, tempPath, tempnum On Error Resume Next Set xls = CreateObject("Excel.Application") With xls ' Make sure there is no minimized window created .Application.Visible = False ' Add a new workbook .Workbooks.Add ' Select some cells to put the DATETIME in it .Range("A1:C1").Select .Selection.MergeCells = True .Selection = Now ' populate some cells For I = 2 To 15 For J = 2 To 20 tempnum = 12 If J = 15 Then .Cells(J, I).Value = Sqr(i*j) / (i^tempnum) ElseIf J = 10 Then .Cells(J, I).Value = (i+j) * (i^tempnum) Else .Cells(J, I).Value = (i+j)^2 End If Next Next .Charts.Add .ActiveChart.ChartType = 67 'xlLineMarkersStacked100 = 67 ' xlColumns = 2 .ActiveChart.SetSourceData .Sheets("Sheet1").Range("B2:O20"), 2 ' xlLocationAsNewSheet = 1 .ActiveChart.Location 1 With .ActiveChart .HasTitle = True .ChartTitle.Characters.Text = "My Kewl Chart number #" & CStr(tempnum) .Axes(1, 1).HasTitle = True .Axes(1, 1).AxisTitle.Characters.Text = "X axis for you" .Axes(2, 1).HasTitle = True .Axes(2, 1).AxisTitle.Characters.Text = "Y axis for me" End With With .ActiveChart.Axes(1) .HasMajorGridlines = True .HasMinorGridlines = False End With With .ActiveChart.Axes(2) .HasMajorGridlines = True .HasMinorGridlines = False End With .ActiveChart.HasLegend = True .ActiveChart.Legend.Select ' xlBottom = -4107 .Selection.Position = -4107 ' xlDataLabelsShowNone = -4142 .ActiveChart.ApplyDataLabels -4142, False .ActiveChart.HasDataTable = False ' Make a path for the file to be saved tempName = Hour(Now) & Minute(Now) & Second(Now) & ".xls" tempPath = "d:inetpubwwwroot esting" & tempName ' Save the Workbook in my web drive .Application.DisplayAlerts = False .Sheets("Sheet2").Select .ActiveWindow.SelectedSheets.Delete .Sheets("Sheet3").Select .ActiveWindow.SelectedSheets.Delete .Sheets("Chart1").Select .Application.DisplayAlerts = True .ActiveWorkbook.SaveAs tempPath '.ActiveWorkBook.PrintOut 1 .ActiveWorkbook.Close ' VERY IMPORTANT HERE ' Quit the Application ' xls.Quit is NOT enough...is it only the reference to the Excel Object ' you still have to terminate the Application .Application.Quit End With ' VERY IMPORTANT HERE ' Release the memory Set xls = Nothing '*********************************** 'WORD Dim wrd, doc, filepath, filename On Error Resume Next Set wrd = CreateObject("Word.Application") With wrd ' Make sure there is no minimized window created .Application.Visible = False ' Add a new document .Documents.Add filepath = "d:inetpubwwwroot" filename = "silly" & Second(Now) & ".doc" .ActiveDocument.SaveAs filepath & filename, 0 ' Word Document Format doc = "This is a document" & vbCrLf doc = doc & "IDENTIFICATION: ME!!!" & vbCrLf doc = doc & Date & vbCrLf doc = doc & filepath & vbCrLf & vbCrLf doc = doc & "WHAT DO YOU WANT???" With .Selection .Selection.TypeText doc .Selection.WholeStory .Selection.Font.Name = "Courier New" .Selection.Font.Bold = True .Selection.Font.Italic = True .Selection.Font.Size = 32 .Selection.HomeKey End With .ActiveDocument.Close -1 'Save Changes ' VERY IMPORTANT HERE ' Quit the Application ' wrd.Quit is NOT enough...is it only the reference to the Word Object ' you still have to terminate the Application .Application.Quit End With ' VERY IMPORTANT HERE ' Release the memory Set wrd = Nothing '*********************************** 'MSACCESS Dim msa, I, J, tempName, tempPath, tempnum Dim Mywk, newDb On Error Resume Next Set msa = CreateObject("Access.Application") tempName = Hour(Now) & Minute(Now) & Second(Now) & ".mdb" tempPath = "d:inetpubwwwroot esting" & tempName Set Mywk = msa.DBEngine.Workspaces(0) Set newDb = Mywk.CreateDatabase(tempPath, ";LANGID=0x0409;CP=1252;COUNTRY=0") newDb.close Mywk.Close Set newDb = Nothing Set Mywk = Nothing msa.Application.Quit Set msa = Nothing '*********************************** 'POWERPOINT '*********************************** Dim ppt, I, J, tempName, tempPath, tempnum On Error Resume Next Set ppt = CreateObject("PowerPoint.Application") tempName = Hour(Now) & Minute(Now) & Second(Now) & ".ppt" tempPath = "d:inetpubwwwroot esting" & tempName ppt.Presentations.Add -1 ppt.ActiveWindow.View.GotoSlide ppt.ActivePresentation.Slides.Add(1, 12).SlideIndex ppt.ActiveWindow.Selection.SlideRange.Shapes.AddLabel(1, 114, 156, 474, 36).Select ppt.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(1, 0).Select With ppt.ActiveWindow.Selection.TextRange .Text = "WOW THIS WORKS!!!" With .Font .Name = "Times New Roman" .Size = 24 .Bold = 0 .Italic = 0 .Underline = 0 .Shadow = -1 .Emboss = 0 .BaselineOffset = 0 .AutoRotateNumbers = 0 .Color.SchemeColor = 2 End With End With ppt.ActiveWindow.Selection.Unselect ppt.ActivePresentation.SaveAs tempPath ppt.ActivePresentation.Close ' there is no Application object for PPT, so just quit ppt ppt.Quit ' Release the memory to PPT Set ppt = Nothing %>