Hi Guys,

Can you help on the abovementioned title of this thread.

Thank you very much.

Recommended Answers

All 2 Replies

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.

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.