Output MsgBox results to EXCEL

  • Thread starter Thread starter DizzyD
  • Start date Start date
D

DizzyD

Hello all,
I currently have a vb script that runs and reads all
files in a folder and then shows the file name and the
last line of each file (it has the totals) in a msg box
for each file. Something like ; ABC-12324 = Total# 97 . I
would like alter the script to push the MsgBox info to a
new spreadsheet.

************************************************
Partial script:
*************************
Public Function GetData()
Set Sh = CreateObject("WScript.Shell")
mstrPath = Sh.CurrentDirectory
Set Sh = Nothing
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(mstrPath)
Set Files = Folder.Files

If Files.Count <> 0 Then
For Each File In Files
If LCase(Trim(Right(File.Name,3))) = mstrExtension
Then
Set objFile = FSO.OpenTextFile(File, 1)
strLine = ""
Do Until objFile.AtEndOfStream
strLine = objFile.ReadLine
Loop
objFile.Close
MsgBox File.Name & " = " & strLine

'Load Excel
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
x = 1
strComputer = "."

*********************************************
With this I get the MsgBox and the spreadsheet opens but
that's it. No data gets to Excel.
What am I missing???
Thanks,
 
Public Function GetData()
Set Sh = CreateObject("WScript.Shell")
mstrPath = Sh.CurrentDirectory
Set Sh = Nothing
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(mstrPath)
Set Files = Folder.Files
rw = 0
If Files.Count <> 0 Then
For Each File In Files
If LCase(Trim(Right(File.Name,3))) = mstrExtension
Then
Set objFile = FSO.OpenTextFile(File, 1)
strLine = ""
Do Until objFile.AtEndOfStream
strLine = objFile.ReadLine
Loop
objFile.Close
MsgBox File.Name & " = " & strLine
rw = rw + 1
workbooks("Summary.xls").worksheets("Summary") _
.cells(rw,1).Value = file.Name & " = " & strLine
'Load Excel
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
x = 1
strComputer = "."
 
Thanks Tom,
Unfortunately that did not work... It did not display
anything in Excel - it did create the worksheet. My vb
script reads the last line of a file (containing totals)
and display a MsgBox with the file Name and the last line
of the file (Total#: ). I would like instead of the
MsgBox to have the script open Excel (which it does) then
put the file name in one column and the Total in another
column, with approiate Column Headings.
 
I assume you don't want to create a new workbook for each file, so you need
to open excel before you begin looping.

Public Function GetData()
Set Sh = CreateObject("WScript.Shell")
mstrPath = Sh.CurrentDirectory
Set Sh = Nothing
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(mstrPath)
Set Files = Folder.Files
'Load Excel
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add

rw = 0
If Files.Count <> 0 Then
For Each File In Files
If LCase(Trim(Right(File.Name,3))) = mstrExtension Then
Set objFile = FSO.OpenTextFile(File, 1)
strLine = ""
Do Until objFile.AtEndOfStream
strLine = objFile.ReadLine
Loop
objFile.Close
'MsgBox File.Name & " = " & strLine
rw = rw + 1
objExcel.Activeworkbook.worksheets(1) _
.cells(rw,1).Resize(1,2).Value = Array(file.Name, strLine)
 
Thanks a million - that did it !!
It did not size column A or B - is that possible to make
it size to fit?? Also, how can I add column header Names
of "File Name" and "Totals"??
 
Public Function GetData()
Set Sh = CreateObject("WScript.Shell")
mstrPath = Sh.CurrentDirectory
Set Sh = Nothing
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(mstrPath)
Set Files = Folder.Files
'Load Excel
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
objExcel.ActiveWorkbook.worksheets(1) _
.Range("A1:B1").Value = Array("File Name", _
"Totals")
rw = 1
If Files.Count <> 0 Then
For Each File In Files
If LCase(Trim(Right(File.Name,3))) = mstrExtension Then
Set objFile = FSO.OpenTextFile(File, 1)
strLine = ""
Do Until objFile.AtEndOfStream
strLine = objFile.ReadLine
Loop
objFile.Close
'MsgBox File.Name & " = " & strLine
rw = rw + 1
objExcel.Activeworkbook.worksheets(1) _
.cells(rw,1).Resize(1,2).Value = Array(file.Name, strLine)

. . .

Next
objExcel.Activeworkbook.Worksheets(1).Columns(1) _
.Resize(,2).Autofit
 
Back
Top