Question : Script to combine all the logs into 1 excel file.As per the selections in a UNC.

Hi,

Script to combine all the logs into 1 excel file.As per the selections in a UNC.

The actual script was provided by Joe
Its a HTA related to software capturing.
Original Q..
http://www.experts-exchange.com/Programming/Languages/Q_26309499.html#a33213939


Regards
Sharath

Answer : Script to combine all the logs into 1 excel file.As per the selections in a UNC.

And if you want Excel, maybe this:
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
'Path to reports
strReportPath="\\SERVER1\MYSHARE"

'Path to XLS file
strXLS="c:\report.xls"


Set objExcel = CreateObject("Excel.Application")
objExcel.DisplayAlerts = false
objExcel.Visible = True
Set objWorkbook = objExcel.Workbooks.Add

Set fso=CreateObject("Scripting.FileSystemObject")

'Does the XLS exist?
If fso.FileExists(strXLS) then
	ret=msgbox("File exists:  " & strXLS & vbCrLf & vbCrLf & "Overwrite?",vbYesNo+vbQuestion,"XLS Report Maker")
	If ret=vbNo then 
		wscript.quit
	Else
		fso.DeleteFile(strXLS)
		If fso.FileExists(strXLS) then
			msgbox "Could not overwrite file:  " & strXLS,vbExclamation,"XLS Report Maker"
			wscript.quit
		End If
	End If
End If

'Loop through TXT reports
For each oFile in fso.GetFolder(strReportPath).Files
	If lcase(fso.GetExtensionName(oFile))="txt" then
		MakeWorksheet oFile
	End If
Next

For each sheet in objWorkbook.Worksheets
	If left(sheet.Name,5)="Sheet" then sheet.Delete
Next

objExcel.DisplayAlerts = true
'objExcel.save strXLS
objWorkbook.SaveAs strXLS

Sub MakeWorksheet(oFile)
	strWorksheet = fso.GetBaseName(oFile)
	Set objWorksheetNew = objWorkbook.Worksheets.Add
	objWorksheetNew.Name=strWorksheet
	
	Set oFile=fso.OpenTextFile(oFile)
	text=oFile.ReadAll
	oFile.close
	
	arrText = split(text,vbCrLf)
	
	'Write Headers
	intRow=1
	objWorksheetNew.Cells(intRow,1).Value="Software Title"
	objWorksheetNew.Cells(intRow,2).Value="Software Comment"
	
	For each line in arrText
		If instr(line,vbTab) then
			arrLine=split(line,vbTab)
			intRow=intRow+1
			objWorksheetNew.Cells(intRow,1).Value=arrLine(0)
			objWorksheetNew.Cells(intRow,2).Value=arrLine(1)
		End If
	Next
	
	objWorkSheetNew.Cells.EntireColumn.AutoFit
	Set objWorksheetNew = Nothing
	Set oFile=Nothing
End Sub
Random Solutions  
 
programming4us programming4us