Excel Zelle in Textdatei (txt) rausschreiben/exportieren

[wbendl]

Hi!

Dieser Code sollte den gewünschten Effekt bringen.

Private Sub Export()
  Dim cnn As New ADODB.Connection
  Dim rst As New ADODB.Recordset
  Dim strSQL As String
 
  Dim intFilehandle As Integer
  Dim strFilename As String
 
  Dim fld As Field
  Dim strLine As String
 
  cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
      & "Extended Properties=""Excel 8.0;HDR=YES;"";" _
      & "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";"
 
  strSQL = "SELECT [Vorname], [Nachname], [E-Mal Adresse] FROM [Tabelle1$A:E]"
 
  cnn.Open
  rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
 
  strFilename = ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 3) & "txt"
 
  intFilehandle = FreeFile()
  Open strFilename For Output As intFilehandle
 
  Do While Not rst.EOF
    For Each fld In rst.Fields
      strLine = strLine & fld.Value & ";"
    Next
      strLine = Left(strLine, Len(strLine) - 1)
      Print #intFilehandle, strLine
      strLine = vbNullString
    rst.MoveNext
  Loop
  Close #intFilehandle
 
End Sub

Ein Verweis auf ADO muß gesetzt werden.
Einige Parameter müssen angepaßt werden

Name und Pfad der txt werden aus der xls übernommen.


mfg

WB