'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
|