Author : ASIT BASAK
Date Submitted : 1/21/2005
Category : File Manipulation
Compatibility : VB 6
This code has been accessed 13313 times.
Task : Convert excel to text from command line
Declarations
Code
Private Sub Main()
Dim a, b, s, y As Integer
On Error GoTo Form_Load_Error
'To read from the dos prompt
catch1 = Command$
'MsgBox catch1
cnt = 0
'catch1 = "c:\test.xls Sheet1"
StringLength = Len(catch1)
For currLoc = 1 To StringLength
tmpChar = Mid(catch1, currLoc, 1)
' If InStr(" ", tmpChar) Then
If tmpChar = " " Then
' Replace with a space
'Mid(catch1, currLoc, 1) = " "
cnt = cnt + 1
Else
If cnt >= 1 Then
app = app & " "
cnt = 0
End If
app = app & tmpChar
End If
Next
catch = app
a = InStr(1, Trim(catch), "xls")
b = InStr(1, Trim(catch), "nobypass")
s = InStr(1, Trim(catch), " ")
y = InStr(s + 1, Trim(catch), " ")
'slas = InStr(1, Trim(catch), "\")
If Val(s) = 0 And Val(y) = 0 Then
If a > 0 Then
nm = catch
fl = Mid$(nm, 1, (Len(nm) - 4)) & ".txt"
Else
nm = catch & ".xls"
fl = catch & ".txt"
End If
sh = "Sheet1$"
End If
If Val(y) = 0 And Val(s) <> 0 Then
If a > 0 Then
nm = Mid$(catch, 1, s - 1)
fl = Mid$(nm, 1, (Len(nm) - 4)) & ".txt"
Else
nm = Mid$(catch, 1, s - 1) & ".xls"
fl = Mid$(nm, 1, s - 1) & ".txt"
End If
sh = Mid$(catch, s + 1, Len(catch)) & "$"
End If
If Val(s) <> 0 And Val(y) <> 0 Then
If a > 0 Then
nm = Mid$(catch, 1, s - 1)
Else
nm = Mid$(catch, 1, s - 1) & ".xls"
End If
sh = Mid$(catch, Val(s + 1), Val(y - s - 1)) & "$"
If Val(b) = 0 Then
fl = Mid$(catch, Val(y + 1), Len(catch))
Else
fl = Mid$(catch, Val(y + 1), Val(b - y - 1))
End If
End If
Set rs = New ADODB.Recordset
Set cnn = New ADODB.Connection
'myPath = "C:\" & nm
myPath = nm
'If rs.State = 1 Then rs.Close
cnn.Open "Driver={Microsoft Excel Driver (*.xls)};DBQ=" & myPath & ";ReadOnly=1"
rs.Open "SELECT * FROM [" & sh & "]", cnn
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.CreateTextFile(fl, True)
Do While Not rs.EOF
i = 0
For Each fld In rs.Fields
If Val(b) > 0 Then
fldCat = fldCat & IIf(IsNull(fld), "|", fld & "|")
Else
If IsNull(fld) = True Then
Else
'fldCat = fldCat & fld & "|"
If i = 0 Then
fldCat = fldCat & fld
Else
fldCat = fldCat & "|" & fld
End If
i = i + 1
End If
End If
Next
If i <> 0 Then
ts.WriteLine (Trim(fldCat))
End If
fldCat = ""
rs.MoveNext
Loop
ts.Close
' Open " & x & " For Input As #1
'
' Close 1#
On Error Resume Next
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
If Not cnn Is Nothing Then
cnn.Close
Set cnn = Nothing
End If
On Error GoTo 0
'Form_Load_Exit:
Exit Sub
Form_Load_Error:
MsgBox "Usage : Excel-File [Sheet Output nobypass] " & vbCrLf & _
"Example: cett xyz.xls sheet1 out.txt -create out.txt from xyz.xls sheet1 sheet" & vbCrLf & Space(13) & _
" cett xyz.xls jan jan.txt -create jan.txt from xyz.xls jan sheet " & vbCrLf & _
" cett xyz -create xyz.txt from xyz.xls sheet1 sheet " & vbCrLf & _
" cett xyz.xls exp exp.txt nobypass -create exp.txt from xyz.xls exp sheet" & vbCrLf & _
" without bypassing the blank lines ", , "CETT : Convert Excel To Text"
End Sub