Excel Sheet To Tab Delimited file using Com

[John Hackl]

'After much playing around, it sure looks like the fastest way to get usable
'data from an excel worksheet to pb is save the sheet as a text file.  This
'uses PB com to create a tab delimited text file.
'1. In Excel, create Book1.xls
'2. Put some data in Sheet1
'3. Save it, close it and exit Excel
'4. Run SheetToTab
#COMPILE EXE "SheetToTab.exe"
#DIM ALL
#INCLUDE "ExcelApp.inc"
FUNCTION PBMAIN
    DIM StartTime AS LONG
    StartTime = TIMER
    DIM oExcelApp       AS ExcelApplication
    DIM oExcelWorkbook  AS ExcelWorkbook
    DIM vFalse          AS VARIANT
    DIM vTrue           AS VARIANT
    DIM oVnt            AS VARIANT
    DIM vInFile         AS VARIANT
    DIM vInSheet        AS VARIANT
    DIM vOutDirFile     AS VARIANT
    DIM vSaveAsType     AS VARIANT
    LET vFalse = 0
    LET vTrue = 1
    LET vSaveAsType = %xlText

    SET oExcelApp = ExcelApplication IN $PROGID_ExcelApplication8
    IF ISFALSE ISOBJECT(oExcelApp) THEN ' _
        SET oExcelApp = NEW ExcelApplication IN $PROGID_ExcelApplication8
    ELSE
        OBJECT LET oExcelApp.Visible = vTrue
    END IF
    ON ERROR GOTO Terminate

    LET vInFile = "Book1.xls"
    LET vInSheet = "Sheet1"
    LET vOutDirFile = "Book1.txt"

    OBJECT CALL oExcelApp.WorkBooks.Open(Filename = vInFile, UpdateLinks=vFalse) TO oVnt
    SET oExcelWorkbook = oVnt
    OBJECT CALL oExcelApp.Sheets(vInSheet).SELECT
    OBJECT LET oExcelApp.DisplayAlerts = vFalse
    OBJECT CALL oExcelWorkbook.SaveAs(Filename=vOutDirFile, FileFormat=vSaveAsType , CreateBackup=vFalse)
    OBJECT CALL oExcelWorkbook.Close(SaveChanges=vFalse)
    OBJECT LET oExcelApp.DisplayAlerts = vTrue
Terminate:
    SET oExcelApp       = NOTHING
    SET oExcelWorkbook  = NOTHING

    OPEN "Book1.txt" FOR APPEND AS #1
    PRINT #1, "Pb Time: " + STR$(TIMER-StartTime)
    CLOSE #1

END FUNCTION

[John Hackl]

'multiple sheet version
'requires pbcc3.02 (or pbwin7.02)

[FONT=Verdana, Arial][SIZE=2][FONT=Courier New, Courier][SIZE=3]#COMPILE EXE "SheetsToTab.exe"
#DIM ALL
#INCLUDE "Excel.inc" 'version independent - see last reply at [URL="http://www.powerbasic.com/support/pbforums/../forums/Forum7/HTML/001657.html"]http://www.powerbasic.com/support/forums/Forum7/HTML/001657.html[/URL]
FUNCTION PBMAIN[/SIZE][/FONT][/SIZE][/FONT][FONT=Verdana, Arial][SIZE=2][FONT=Courier New, Courier][SIZE=3]    DIM sInfile             AS STRING
    DIM sOutFileBase        AS STRING
    IF COMMAND$ = "" THEN
       STDOUT "SheetsToTab.exe C:\Directory\File.xls"
       EXIT FUNCTION
    ELSE
       IF INSTR(COMMAND$,"\") = 0 THEN
          sInfile = CURDIR$+"\"+COMMAND$
       ELSE
          sInFile = COMMAND$
       END IF
       IF DIR$(sInfile) = "" THEN
          STDOUT sInfile & " Not Found"
          EXIT FUNCTION
       END IF
       sOutFileBase = PARSE$(sInfile,".",1)
    END IF[/SIZE][/FONT][/SIZE][/FONT]
[FONT=Verdana, Arial][SIZE=2][FONT=Courier New, Courier][SIZE=3]    DIM oExcelApp           AS ExcelApplication
    DIM vInFile             AS VARIANT
    DIM oExcelWorkbook      AS ExcelWorkbook
    DIM vExcelWorkbook      AS VARIANT
    DIM oExcelWorkSheet     AS ExcelWorkSheet
    DIM vExcelWorkSheet     AS VARIANT
    DIM vExcelWorkSheetName AS VARIANT
    DIM vFalse              AS VARIANT
    DIM vTrue               AS VARIANT
    DIM vSaveAsType         AS VARIANT
    DIM vWorkSheetsCount    AS VARIANT
    DIM l                   AS LONG
    DIM vl                  AS VARIANT
    DIM vOutDirFile         AS VARIANT[/SIZE][/FONT][/SIZE][/FONT]
[FONT=Verdana, Arial][SIZE=2][FONT=Courier New, Courier][SIZE=3]    LET vFalse = 0
    LET vTrue = 1
    LET vSaveAsType = %xlText[/SIZE][/FONT][/SIZE][/FONT]
[FONT=Verdana, Arial][SIZE=2][FONT=Courier New, Courier][SIZE=3]    SET oExcelApp = ExcelApplication IN $PROGID_ExcelApplication
    IF ISFALSE ISOBJECT(oExcelApp) THEN
        SET oExcelApp = NEW ExcelApplication IN $PROGID_ExcelApplication
    ELSE
        OBJECT LET oExcelApp.Visible = vTrue
    END IF
    ON ERROR GOTO Terminate[/SIZE][/FONT][/SIZE][/FONT]
[FONT=Verdana, Arial][SIZE=2][FONT=Courier New, Courier][SIZE=3]    LET vInFile = sInFile
    OBJECT CALL oExcelApp.WorkBooks.Open(Filename = vInFile, UpdateLinks=vFalse) TO vExcelWorkBook
    SET oExcelWorkbook = vExcelWorkbook[/SIZE][/FONT][/SIZE][/FONT]
[FONT=Verdana, Arial][SIZE=2][FONT=Courier New, Courier][SIZE=3]    OBJECT GET oExcelWorkbook.WorkSheets.Count TO vWorkSheetsCount
    OBJECT LET oExcelApp.DisplayAlerts = vFalse[/SIZE][/FONT][/SIZE][/FONT]
[FONT=Verdana, Arial][SIZE=2][FONT=Courier New, Courier][SIZE=3]    FOR l = 1 TO VARIANT#(vWorkSheetsCount)
        LET vl = l
        OBJECT GET oExcelWorkbook.WorkSheets.Item(vl) TO vExcelWorkSheet
        SET oExcelWorkSheet = vExcelWorkSheet
        OBJECT GET oExcelWorkSheet.Name TO vExcelWorkSheetName
        LET vOutDirFile = sOutFileBase & VARIANT$(vExcelWorkSheetName) &  ".txt" '& TRIM$(STR$(l)) &  ".txt"
        OBJECT CALL oExcelWorkSheet.Select
        OBJECT CALL oExcelWorkSheet.UsedRange.ClearFormats
        OBJECT CALL oExcelWorkbook.SaveAs(Filename=vOutDirFile, FileFormat=vSaveAsType , CreateBackup=vFalse)
        STDOUT "Created " & VARIANT$(vOutDirFile)
    NEXT l[/SIZE][/FONT][/SIZE][/FONT]
[FONT=Verdana, Arial][SIZE=2][FONT=Courier New, Courier][SIZE=3]    OBJECT CALL oExcelWorkbook.Close(SaveChanges=vFalse)
    OBJECT LET oExcelApp.DisplayAlerts = vTrue[/SIZE][/FONT][/SIZE][/FONT]
[FONT=Verdana, Arial][SIZE=2][FONT=Courier New, Courier][SIZE=3]Terminate:
    SET oExcelWorkSheet = NOTHING
    SET oExcelWorkbook  = NOTHING
    SET oExcelApp       = NOTHING
END FUNCTION[/SIZE][/FONT][/SIZE][/FONT]

'added clearformats to eliminate of commas and quotes in style = "comma" cells

[this message has been edited by john hackl (edited november 13, 2003).]