Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 449
  • Last Modified:

VBscript to output to excel format

Hi All,

I have a script put together by a nice fellow on a previous question.  The script inputs a fixed length file with numerous fields, and then outputs some of those fields as a tab delimited file.

Instead, I would like to output into excel 2007 format with each variable (for example Account, Year, Owner) written into the first row as column headers with the width of each cell a bit more than the defined field length.

Any help appreciated,

Thanks,

J
' Define needed constants
Const ForReading = 1
Const ForWriting = 2
Const TriStateUseDefault = -2
cTab = Chr(9)

' Get input and output file names from command line parms
If (WScript.Arguments.Count > 0) Then
  sInfile = WScript.Arguments(0)
Else
  WScript.Echo "No input filename specified."
  WScript.Quit
End If
If (WScript.Arguments.Count > 1) Then
  sOutfile = WScript.Arguments(1)
Else
  WScript.Echo "No output filename specified."
  WScript.Quit
End If

' Create file system object
Set oFSO = CreateObject("Scripting.FileSystemObject")

' Read entire input file into a variable and close it
Set oInfile = oFSO.OpenTextFile(sInfile, ForReading, False, TriStateUseDefault)
Set oOutfile = oFSO.OpenTextFile(sOutfile, ForWriting, True)

Do While Not oInfile.AtEndOfStream
   sLine = oInfile.ReadLine
   Account = Trim(Mid(sLine, 1, 22))
   TYear = Trim(Mid(sLine, 23, 4))
   Over65 = Trim(Mid(sLine, 65, 1))
   Veteran = Trim(Mid(sLine, 66, 1))
   Disabled = Trim(Mid(sLine, 67, 1))
   DatePaid = Trim(Mid(sLine, 69, 8))
   LevyBalance = Trim(Mid(sLine, 87, 11))
   BankRupt = Trim(Mid(sLine, 139, 1))
   Owner = Trim(Mid(sLine, 202, 40))
   Address2 = Trim(Mid(sLine, 242, 40))
   Address3 = Trim(Mid(sLine, 282, 40))
   Address4 = Trim(Mid(sLine, 322, 40))
   City = Trim(Mid(sLine, 362, 24))
   State = Trim(Mid(sLine, 386, 2))
   ZipCode = Mid(sLine, 388, 5) & "-" & Mid(sLine, 393, 4)
   
   If (TYear <> "" And CLng(TYear) < 2010) And Over65 = "" And Veteran = "" And Disabled = "" And DatePaid = "" And (LevyBalance <> "" And CLng(LevyBalance) >= 2500) And BankRupt = "" Then
      oOutfile.WriteLine(Account & cTab & TYear & cTab & LevyBalance & cTab & Owner & cTab & Address2 & cTab & Address3 & cTab & Address4 & cTab & City & cTab & State & cTab & ZipCode)
   End If
   Loop

' Cleanup and end
oInfile.Close
Set oInfile = Nothing
oOutfile.Close
Set oOutfile = Nothing
Set oFSO = Nothing

Open in new window

0
jon1966
Asked:
jon1966
  • 6
  • 5
1 Solution
 
rlandquistCommented:
Do you want the script to show the excel file when it is finished or just create it and close it?
0
 
jon1966Author Commented:
To show the excel file would be best.

Currently I use "cscript process.vbs input_file output_file".
0
 
rlandquistCommented:
Give this a try.
I commented out lines 91 and 92 to leave the spreadsheet open.  If you want it closed at the end of the script, just uncomment those lines.

Let me know how this works for you.
' Define needed constants
Const ForReading = 1
Const ForWriting = 2
Const TriStateUseDefault = -2
Const xlSaveChanges = 1 'Excel Save Changes
Const xlAscending = 1 'Excel Sort Ascending
Const xlDescending = 2 'Excel Sort Decending
Const xlYes = 1 'Excel Header Row Exists

cTab = Chr(9)

' Get input and output file names from command line parms
If (WScript.Arguments.Count > 0) Then
    sInfile = WScript.Arguments(0)
Else
    WScript.Echo "No input filename specified."
    WScript.Quit
End If
If (WScript.Arguments.Count > 1) Then
    sOutfile = WScript.Arguments(1)
Else
    WScript.Echo "No output filename specified."
    WScript.Quit
End If

'Create Excel Object
Set objExcel = CreateObject("Excel.Application")
objExcel.DisplayAlerts = False 'Disable Overwrite Prompts
objExcel.Visible = True 'Hides Excel window

'Create Excel worksheet and add header row
objExcel.Workbooks.Add()
objExcel.Cells(1, 1) = "Account"
objExcel.Cells(1, 2) = "TYear"
objExcel.Cells(1, 3) = "LevyBalance"
objExcel.Cells(1, 4) = "Owner"
objExcel.Cells(1, 5) = "Address2"
objExcel.Cells(1, 6) = "Address3"
objExcel.Cells(1, 7) = "Address4"
objExcel.Cells(1, 8) = "City"
objExcel.Cells(1, 9) = "State"
objExcel.Cells(1, 10) = "ZipCode"
intRow = 2 'Set first row to add data

' Create file system object
Set oFSO = CreateObject("Scripting.FileSystemObject")

' Read entire input file into a variable and close it
Set oInfile = oFSO.OpenTextFile(sInfile, ForReading, False, TriStateUseDefault)

Do While Not oInfile.AtEndOfStream
    sLine = oInfile.ReadLine
    Account = Trim(Mid(sLine, 1, 22))
    TYear = Trim(Mid(sLine, 23, 4))
    Over65 = Trim(Mid(sLine, 65, 1))
    Veteran = Trim(Mid(sLine, 66, 1))
    Disabled = Trim(Mid(sLine, 67, 1))
    DatePaid = Trim(Mid(sLine, 69, 8))
    LevyBalance = Trim(Mid(sLine, 87, 11))
    BankRupt = Trim(Mid(sLine, 139, 1))
    Owner = Trim(Mid(sLine, 202, 40))
    Address2 = Trim(Mid(sLine, 242, 40))
    Address3 = Trim(Mid(sLine, 282, 40))
    Address4 = Trim(Mid(sLine, 322, 40))
    City = Trim(Mid(sLine, 362, 24))
    State = Trim(Mid(sLine, 386, 2))
    ZipCode = Mid(sLine, 388, 5) & "-" & Mid(sLine, 393, 4)
           
    If (TYear <> "" And CLng(TYear) < 2010) And Over65 = "" And Veteran = "" And Disabled = "" And DatePaid = "" And ( LevyBalance <> "" And CLng(LevyBalance) >= 2500 ) And BankRupt = "" Then
        objExcel.Cells(1, 1) = Account
        objExcel.Cells(1, 2) = TYear
        objExcel.Cells(1, 3) = LevyBalance
        objExcel.Cells(1, 4) = Owner
        objExcel.Cells(1, 5) = Address2
        objExcel.Cells(1, 6) = Address3
        objExcel.Cells(1, 7) = Address4
        objExcel.Cells(1, 8) = City
        objExcel.Cells(1, 9) = State
        objExcel.Cells(1, 10) = ZipCode
        intRow = intRow + 1
    End If
Loop

'Format and Sort Excel workbook
Set objSheet = objExcel.ActiveWorkbook.ActiveSheet
Set objRange = objSheet.UsedRange
objRange.EntireColumn.AutoFit()
	
'Save Excel Workbook
objExcel.ActiveWorkbook.SaveAs(sOutfile)
'objExcel.ActiveWorkbook.Close xlSaveChanges
'objExcel.Quit
WScript.Echo "Script Finished"

' Cleanup and end
oInfile.Close
Set oInfile = Nothing
Set oFSO = Nothing

Open in new window

0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
jon1966Author Commented:
Hi,

It just wrote to the first row of the excel, without first writing the column headers.


4-21-2011-2-28-21-PM.jpg
0
 
rlandquistCommented:
I had a copy paste issue.  Sorry about that.
' Define needed constants
Const ForReading = 1
Const ForWriting = 2
Const TriStateUseDefault = -2
Const xlSaveChanges = 1 'Excel Save Changes
Const xlAscending = 1 'Excel Sort Ascending
Const xlDescending = 2 'Excel Sort Decending
Const xlYes = 1 'Excel Header Row Exists

cTab = Chr(9)

' Get input and output file names from command line parms
If (WScript.Arguments.Count > 0) Then
    sInfile = WScript.Arguments(0)
Else
    WScript.Echo "No input filename specified."
    WScript.Quit
End If
If (WScript.Arguments.Count > 1) Then
    sOutfile = WScript.Arguments(1)
Else
    WScript.Echo "No output filename specified."
    WScript.Quit
End If

'Create Excel Object
Set objExcel = CreateObject("Excel.Application")
objExcel.DisplayAlerts = False 'Disable Overwrite Prompts
objExcel.Visible = True 'Hides Excel window

'Create Excel worksheet and add header row
objExcel.Workbooks.Add()
objExcel.Cells(1, 1) = "Account"
objExcel.Cells(1, 2) = "TYear"
objExcel.Cells(1, 3) = "LevyBalance"
objExcel.Cells(1, 4) = "Owner"
objExcel.Cells(1, 5) = "Address2"
objExcel.Cells(1, 6) = "Address3"
objExcel.Cells(1, 7) = "Address4"
objExcel.Cells(1, 8) = "City"
objExcel.Cells(1, 9) = "State"
objExcel.Cells(1, 10) = "ZipCode"
intRow = 2 'Set first row to add data

' Create file system object
Set oFSO = CreateObject("Scripting.FileSystemObject")

' Read entire input file into a variable and close it
Set oInfile = oFSO.OpenTextFile(sInfile, ForReading, False, TriStateUseDefault)

Do While Not oInfile.AtEndOfStream
    sLine = oInfile.ReadLine
    Account = Trim(Mid(sLine, 1, 22))
    TYear = Trim(Mid(sLine, 23, 4))
    Over65 = Trim(Mid(sLine, 65, 1))
    Veteran = Trim(Mid(sLine, 66, 1))
    Disabled = Trim(Mid(sLine, 67, 1))
    DatePaid = Trim(Mid(sLine, 69, 8))
    LevyBalance = Trim(Mid(sLine, 87, 11))
    BankRupt = Trim(Mid(sLine, 139, 1))
    Owner = Trim(Mid(sLine, 202, 40))
    Address2 = Trim(Mid(sLine, 242, 40))
    Address3 = Trim(Mid(sLine, 282, 40))
    Address4 = Trim(Mid(sLine, 322, 40))
    City = Trim(Mid(sLine, 362, 24))
    State = Trim(Mid(sLine, 386, 2))
    ZipCode = Mid(sLine, 388, 5) & "-" & Mid(sLine, 393, 4)
           
    If (TYear <> "" And CLng(TYear) < 2010) And Over65 = "" And Veteran = "" And Disabled = "" And DatePaid = "" And ( LevyBalance <> "" And CLng(LevyBalance) >= 2500 ) And BankRupt = "" Then
        objExcel.Cells(intRow, 1) = Account
        objExcel.Cells(intRow, 2) = TYear
        objExcel.Cells(intRow, 3) = LevyBalance
        objExcel.Cells(intRow, 4) = Owner
        objExcel.Cells(intRow, 5) = Address2
        objExcel.Cells(intRow, 6) = Address3
        objExcel.Cells(intRow, 7) = Address4
        objExcel.Cells(intRow, 8) = City
        objExcel.Cells(intRow, 9) = State
        objExcel.Cells(intRow, 10) = ZipCode
        intRow = intRow + 1
    End If
Loop

'Format and Sort Excel workbook
Set objSheet = objExcel.ActiveWorkbook.ActiveSheet
Set objRange = objSheet.UsedRange
objRange.EntireColumn.AutoFit()
	
'Save Excel Workbook
objExcel.ActiveWorkbook.SaveAs(sOutfile)
'objExcel.ActiveWorkbook.Close xlSaveChanges
'objExcel.Quit
WScript.Echo "Script Finished"

' Cleanup and end
oInfile.Close
Set oInfile = Nothing
Set oFSO = Nothing

Open in new window

0
 
jon1966Author Commented:
Sweet,

Thank you!

Any way to have the cell widths formatted to a bit more than the fixed field widths?  Also, can the Account field be formatted to Number?  Currently excel has it as general cause the E notation...Last can the column output for TYear be just "Year"  I used the variable TYear so as not to be confused with a function.

J
0
 
rlandquistCommented:
Let me fix it up some more and get back to you.
0
 
rlandquistCommented:
Give this a try:
' Define needed constants
Const ForReading = 1
Const ForWriting = 2
Const TriStateUseDefault = -2
Const xlSaveChanges = 1 'Excel Save Changes
Const xlAscending = 1 'Excel Sort Ascending
Const xlDescending = 2 'Excel Sort Decending
Const xlYes = 1 'Excel Header Row Exists

cTab = Chr(9)

' Get input and output file names from command line parms
If (WScript.Arguments.Count > 0) Then
    sInfile = WScript.Arguments(0)
Else
    WScript.Echo "No input filename specified."
    WScript.Quit
End If
If (WScript.Arguments.Count > 1) Then
    sOutfile = WScript.Arguments(1)
Else
    WScript.Echo "No output filename specified."
    WScript.Quit
End If

'Create Excel Object
Set objExcel = CreateObject("Excel.Application")
objExcel.DisplayAlerts = False 'Disable Overwrite Prompts
objExcel.Visible = True 'Hides Excel window

'Create Excel worksheet and add header row
objExcel.Workbooks.Add()
objExcel.Cells(1, 1) = "Account"
objExcel.Cells(1, 2) = "Year"
objExcel.Cells(1, 3) = "LevyBalance"
objExcel.Cells(1, 4) = "Owner"
objExcel.Cells(1, 5) = "Address2"
objExcel.Cells(1, 6) = "Address3"
objExcel.Cells(1, 7) = "Address4"
objExcel.Cells(1, 8) = "City"
objExcel.Cells(1, 9) = "State"
objExcel.Cells(1, 10) = "ZipCode"
intRow = 2 'Set first row to add data

' Create file system object
Set oFSO = CreateObject("Scripting.FileSystemObject")

' Read entire input file into a variable and close it
Set oInfile = oFSO.OpenTextFile(sInfile, ForReading, False, TriStateUseDefault)

Do While Not oInfile.AtEndOfStream
    sLine = oInfile.ReadLine
    Account = Trim(Mid(sLine, 1, 22))
    TYear = Trim(Mid(sLine, 23, 4))
    Over65 = Trim(Mid(sLine, 65, 1))
    Veteran = Trim(Mid(sLine, 66, 1))
    Disabled = Trim(Mid(sLine, 67, 1))
    DatePaid = Trim(Mid(sLine, 69, 8))
    LevyBalance = Trim(Mid(sLine, 87, 11))
    BankRupt = Trim(Mid(sLine, 139, 1))
    Owner = Trim(Mid(sLine, 202, 40))
    Address2 = Trim(Mid(sLine, 242, 40))
    Address3 = Trim(Mid(sLine, 282, 40))
    Address4 = Trim(Mid(sLine, 322, 40))
    City = Trim(Mid(sLine, 362, 24))
    State = Trim(Mid(sLine, 386, 2))
    ZipCode = Mid(sLine, 388, 5) & "-" & Mid(sLine, 393, 4)
           
    If (TYear <> "" And CLng(TYear) < 2010) And Over65 = "" And Veteran = "" And Disabled = "" And DatePaid = "" And ( LevyBalance <> "" And CLng(LevyBalance) >= 2500 ) And BankRupt = "" Then
        objExcel.Cells(intRow, 1) = Account
        objExcel.Cells(intRow, 2) = TYear
        objExcel.Cells(intRow, 3) = LevyBalance
        objExcel.Cells(intRow, 4) = Owner
        objExcel.Cells(intRow, 5) = Address2
        objExcel.Cells(intRow, 6) = Address3
        objExcel.Cells(intRow, 7) = Address4
        objExcel.Cells(intRow, 8) = City
        objExcel.Cells(intRow, 9) = State
        objExcel.Cells(intRow, 10) = ZipCode
        intRow = intRow + 1
    End If
Loop

'Format and Sort Excel workbook
Columns("F:F").Select
Selection.NumberFormat = "0"

Set objSheet = objExcel.ActiveWorkbook.ActiveSheet
objSheet.Columns("A:A").NumberFormat = "0"
Set objRange = objSheet.UsedRange
objRange.EntireColumn.AutoFit()
For iW = objRange.Column To objRange.Columns.Count
    colWidth = objSheet.Columns(iW).ColumnWidth
    objSheet.Columns(iW).ColumnWidth = colWidth + 5
Next
	
'Save Excel Workbook
objExcel.ActiveWorkbook.SaveAs(sOutfile)
'objExcel.ActiveWorkbook.Close xlSaveChanges
'objExcel.Quit
WScript.Echo "Script Finished"

' Cleanup and end
oInfile.Close
Set oInfile = Nothing
Set oFSO = Nothing

Open in new window

0
 
jon1966Author Commented:
Great, one tiny problem...

process-rev12.vbs(85, 1) Microsoft VBScript runtime error: Type mismatch: 'Columns'
0
 
rlandquistCommented:
Sorry.  Left over test code.  Delete lines 85-86
0
 
jon1966Author Commented:
Yes, perfect, thank you.
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 6
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now