Hi Guys,
Can you help on the abovementioned title of this thread.
Thank you very much.
Try something like the following:
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim ts As TextStream, fill As File
Dim fso As New FileSystemObject
Dim app As String
Dim i As Integer
Dim sFields As String
Dim sData As String
Dim myPath As String
Dim fld As ADODB.Field
Dim fldCat As String
Dim iSpace As Integer
Dim sSourceData As String
Dim currLoc, cnt As Integer
Dim StringLength As Integer
Dim tmpChar As String
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
thank you it works like a charm. Thank's to you AndreRet and to Daniweb website.
We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.