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
|
Option Explicit
Dim objExcel, strExcelPath, objSheet, intRow, intCol
DIM fso, CSVFile
Dim str
'Bind to Excel object
On error Resume Next
Set objExcel = CreateObject("Excel.Application")
If Err.Number <> 0 Then
On Error Goto 0
Wscript.Echo "Excel application not found."
Wscript.Quit
End If
On Error Goto 0
Set fso = CreateObject("Scripting.FileSystemObject")
'********************************************************
strExcelPath = "c:\test\myxls.xls"
Set CSVFile = fso.CreateTextFile("c:\test\mycsv.CSV", True)
'Open specified spreadsheet and select the worksheet.
objExcel.WorkBooks.Open strExcelPath
Set objSheet = objExcel.ActiveWorkbook.Worksheets("test")
' Iterate through the rows of the spreadsheet after the first, until the
' first blank entry in the third column.
intRow = 2
Do while objSheet.Cells(intRow, 3).Value <> ""
str = ""
FOR intCol = 1 to 18
IF intCol = 2 OR intCOl = 5 OR intCOl = 14 OR intCOl = 15 OR intCOl = 16 OR intCOl = 17 then
str = str & " "
else
str = str & objSheet.Cells(intRow, intCOL).Value
end if
NEXT
Str = str & "x"
CSVFile.Writeline(str)
intRow = intRow + 1
Loop
' Close file
CSVFile.Close
' Close workbook
objExcel.ActiveWorkBook.Close
'Clean up
Set objSheet = Nothing
'*********************************************************
' quit Excel
objExcel.Application.Quit
'Clean up
Set objExcel = Nothing
Wscript.Echo "Done" |
Partager