Announcement

Collapse
No announcement yet.

Import columns from .csv file to Excel SS

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Import columns from .csv file to Excel SS

    HI

    Does anyone know how to import selective coloumns of a .csv file into an excel spread sheet using vbscript?

    Thanks

    Tony
    Last edited by dman4u2no; 8th December 2007, 21:24.

  • #2
    Re: Import columns from .csv file to Excel SS

    Code:
    ' http://forums.petri.com/showthread.p...1640#post71640
    
    'columns csv-file to new xls-file:
    
    Const FOR_READING = 1
    
    strInputFile  = "c:\test.csv"     'path
    strOutputFile = "c:\Output.xls"  'path
    
    ' Get the inputfile
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If objFSO.FileExists(strInputFile) Then
      Set objInputFile = objFSO.GetFile(strInputFile)
      dataFile = objInputFile.ShortName
      Moddate = objInputFile.DateLastModified
    
    ' Read input-file into one string [ -> strInput]
      If objInputFile.Size > 0 Then
        Set objInputFile = objFSO.OpenTextFile(strInputFile, FOR_READING)
        strInput = objInputFile.ReadAll
        objInputFile.Close
      End If
    End If
    
    If Not strInput = "" Then
     ' open excel-workbook-sheet
       Set objExcel = CreateObject("Excel.Application")
       objExcel.Visible = False
       objExcel.UserControl = False
       Set oWB = objExcel.Workbooks.Add()
       Set oSheet = oWB.ActiveSheet
    
       oSheet.Cells(1,1).Value = _
         "Data retrieved from: " & dataFile & " , last modified: " & Moddate
         'oSheet.Range("A1:A2").Font.Bold = true
         'oSheet.Cells(1,1).Font.Size = 13
    
      ' first cell for input data (first row containing table headers)
       startingRow    = 3    '<-- rowNumber
       startingColumn = 2    '<-- columnNumber (counted number!)
    
      ' Add table headers on first row cell by cell
       oSheet.Cells(startingRow,(startingColumn+0)).Value = "First Name"
       oSheet.Cells(startingRow,(startingColumn+1)).Value = "Last Name" 
       oSheet.Cells(startingRow,(startingColumn+2)).Value = "Full Name"
       x = startingRow + 1 'from here insert data
    
    '----------------------------------------------------------------------------
      ' Breaking Input data (strInput) into array at line breaks
       arrRows = Split(strInput, VbCrLf)
      ' Now breaking each Row (in arrRows) into array at commas
       For Each strRow In arrRows 
          arrParams = Split(strRow, ",")
    
         'Select the fields (columns) from the csv-file. 
         ' (it is possible to change the order of apearance of the new columns, with this method). 
         NewColumn1 = arrParams((2)-1)   '<= csv column 2
         NewColumn2 = arrParams((4)-1)   '<= csv column 4
        ' Add the selected values of a row to an array
         arrRowData = Array(NewColumn1,NewColumn2)
         clmns = Ubound(arrRowData)
    
         ' Write data to xls sheet
          nextColumnsCount = clmns
          FromCell = Column2Letter(startingColumn) & x
          ToCell   = Column2Letter(startingColumn+nextColumnsCount) & x
          Set oRng = oSheet.Range(FromCell & ":" & ToCell)
          oRng.Value = arrRowData
    
          x = x + 1 'go to the next Row
       Next
    '----------------------------------------------------------------------------
    
      ' Autofit the new data columns (optional)
       firstcell = Column2Letter(startingColumn) & startingRow
       lastcell  = ToCell
       Set oRng = oSheet.Range(firstcell & ":" & lastcell)
       oRng.Columns.AutoFit
    
       objExcel.DisplayAlerts = False  '<= "overwrite Yes"
       'Set objWorkbook = objExcel.ActiveWorkbook
       oWB.SaveAs strOutputFile
       oWB.Close
       objExcel.Quit
    End If
    
    wscript.echo "done"
    
    
    Function Column2Letter(ColumnNumber)
      If ColumnNumber > 26 Then
    
        ' 1st character:  Subtract 1 to map the characters to 0-25,
        '                 but you don't have to remap back to 1-26
        '                 after the 'Int' operation since columns
        '                 1-26 have no prefix letter
    
        ' 2nd character:  Subtract 1 to map the characters to 0-25,
        '                 but then must remap back to 1-26 after
        '                 the 'Mod' operation by adding 1 back in
        '                 (included in the '65')
    
        Column2Letter = Chr(Int((ColumnNumber - 1) / 26) + 64) & _
                       Chr(((ColumnNumber - 1) Mod 26) + 65)
      Else
        ' Columns A-Z
        Column2Letter = Chr(ColumnNumber + 64)
      End If
    End Function
    \Rems

    This posting is provided "AS IS" with no warranties, and confers no rights.

    __________________

    ** Remember to give credit where credit's due **
    and leave Reputation Points for meaningful posts

    Comment

    Working...
    X