Need to AutoSave the output as xls file with date/time in filename

[stefano5050]

Hi, I have the below code to generate a xls which opens and displays results from a serverlist.txt file. I have the date/time going correctly in column 5, need to autosave the file at completion into current working directory with file name containing date/time.

-------------------
' PING IP to Excel with results
'
' HOSTNAME IP RESULT LATENCY
' -------- -- ------ -------
'

'
'Option Explicit
Dim strHostname, strIP, strPingResult, IntLatency
intRow = 2
Set objExcel = CreateObject("Excel.Application")
With objExcel

.Visible = True
.Workbooks.Add

.Cells(1, 1).Value = "XXXXXXXXXXXXXXXXXXXXXXXXXXX"
.Cells(1, 2).Value = "XXXXXXXXXXXXXX"
.Cells(1, 3).Value = "XXXXXXX"
.Cells(1, 4).Value = "XXXXXXX"

.Range("A1:D1").Select
.Cells.EntireColumn.AutoFit

.Cells(1, 1).Value = "Hostname"
.Cells(1, 2).Value = "IP"
.Cells(1, 3).Value = "Result"
.Cells(1, 4).Value = "Latency"
.Cells(1, 5).Value = "Date/Time"


End With
'--- Input Text File with either Hostames or IP's ---
Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fspenTextFile("serverList.Txt")
Do While Not (InputFile.atEndOfStream)

strHostname = InputFile.ReadLine

Set WshShell = WScript.CreateObject("WScript.Shell")

Call PINGlookup( strHostname, strIP, strPingResult, intLatency )

With objExcel
.Cells(intRow, 1).Value = strHostname
.Cells(intRow, 2).Value = strIP
.Cells(intRow, 3).Value = strPingResult
.Cells(intRow, 4).Value = intLatency
.Cells(intRow, 5).Value = "=NOW()"
End With

intRow = intRow + 1

Loop
With objExcel
.Range("A1:D1").Select
.Selection.Interior.ColorIndex = 19
.Selection.Font.ColorIndex = 11
.Selection.Font.Bold = True
.Cells.EntireColumn.AutoFit
End With

'------------- Subrutines and Functions ----------------
Sub PINGlookup(ByRef strHostname, ByRef strIP, ByRef strPingResult, ByRef intLatency )
' Both IP address and DNS name is allowed
' Function will return the opposite

' Check if the Hostname is an IP
Set oRE = New RegExp
oRE.Pattern = "^[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}$"

' Sort out if IP or Hostname
strMachine = strHostname
bIsIP = oRE.Test(strMachine)
If bIsIP Then
strIP = strMachine
strHostname = "-------"
Else
strIP = "-------"
strHostname = strMachine
End If


' Get a temp filename and open it
Set osShell = CreateObject("Wscript.Shell")
Set oFS = CreateObject("Scripting.FileSystemObject")
sTemp = osShell.ExpandEnvironmentStrings("%TEMP%")
sTempFile = sTemp & "\" & oFS.GetTempName


' PING and check if the IP exists
intT1 = Fix( Timer * 1000 )
osShell.Run "%ComSpec% /c ping -a " & strMachine & " -n 1 > " & sTempFile, 0, True
intT2 = Fix( Timer * 1000 )
intLatency = Fix( intT2 - intT1 ) / 1000


' Open the temp Text File and Read out the Data
Set oTF = oFS.OpenTextFile(sTempFile)

' Parse the temp text file
strPingResult = "-------" 'assume failed unless...
Do While Not oTF.AtEndoFStream

strLine = Trim(oTF.Readline)
If strLine = "" Then
strFirstWord = ""
Else
arrStringLine = Split(strLine, " ", -1, 1)
strFirstWord = arrStringLine(0)
End If

Select Case strFirstWord

Case "Pinging"
If arrStringLine(2) = "with" Then
strPingResult = "-------"
strHostname = "-------"
Else
strHostname = arrStringLine(1)
strIP = arrStringLine(2)
strLen = Len( strIP ) - 2
strIP = Mid( strIP, 2, strLen )
strPingResult = "Ok"
End If
Exit Do
'End Case

Case "Ping" ' pinging non existent hostname
strPingResult = "------"
Exit Do
'End Case

End Select

Loop
'Close it


' oTF.Close
' Delete It
' oFS.DeleteFile sTempFile
End Sub


' ---------------------

 

[John_w]

Immediately after the line:

.Cells.EntireColumn.AutoFit

insert:

.ActiveWorkbook.SaveAs "My Results " & FormatDateTime(Date(), "YYYYMMDD") & ".xls"
.Quit

For the current working directory, see http://www.geekstogo.com/forum/topic/55481-vbscript-get-current-directory/ and include the path in the SaveAs file name.

I have the date/time going correctly in column 5

Are you sure about that? The line:

.Cells(intRow, 5).Value = "=NOW()"

uses a formula, so the values will recalculate as the current time every time the workbook is opened. Try instead:

.Cells(intRow, 5).Value = Now()

 

[stefano5050]

Thanks on the first item i now get a error "type mismatch: "[string: "YYYYMMDD"]"

 

[stefano5050]

if i remove the part

& FormatDateTime(Date(), "YYYYMMDD")

it then saves the file just called my results.xls

 

[John_w]

Thanks on the first item i now get a error "type mismatch: "[string: "YYYYMMDD"]"

Sorry, I was in VBA mode with the date format. See http://classicasp.aspfaq.com/date-t.../can-i-make-vbscript-format-dates-for-me.html for VBScript date formatting functions and code. There is even a function for replicating VBA's Format function. The code is designed for ASP web pages, so omit the <% and %> and instead of response.write assign the result to a string.