Option Explicit
Sub AlleEintraegeEinerSpalteInTxtDateiMitKommaGetrennt()
->*** Für die selektierte Spalte schreibt das Makro
->*** eine Textdatei mit allen Zellinhalten der Spalte
->*** durh Komma getrennt
Dim wb As Workbook, ws As Worksheet
Dim l_rows As Long, l_col As Long, x As Long, s_Spalte As String
Dim ret As Integer, h As Integer
Dim s_datei As String, s_Pfad As String, s_Name As String, s_NameFull As String
Dim VarStringKomma$, VarString$, b_first As Boolean
Set wb = ActiveWorkbook
Set ws = ActiveSheet
If Selection.Columns.Count > 1 Then
MsgBox ( _
Es sind & Selection.Columns.Count & Spalten selektiert. & vbLf & _
Bitte slektieren Sie nur eine Spalte / Zelle.)
Else
l_col = Selection.Column
s_Spalte = ws.Columns(l_col).Address(rowabsolute:=False, columnabsolute:=False)
s_Spalte = Left(s_Spalte, Len(s_Spalte) \ 2)
->Sicheheitsabfrage
ret = MsgBox( _
Sollen die Inhalte der Spalte & s_Spalte & vbLf & _
mit Komma getrennt in eine Txt-Datei geschrieben werden ?, _
vbQuestion + vbDefaultButton1 + vbYesNo)
If ret = vbNo Then GoTo Aufraeumen
->letzte zeile bestimmen
l_rows = ws.Cells(ws.Rows.Count, l_col).End(xlUp).Row
->Dateinamen und Pfad festlegen
s_Pfad = wb.Path
s_Name = Left(wb.Name, Len(wb.Name) - 4) & _
Spalte & l_col & Format(Now(), _yyyymmddhhnn) & _
.txt
s_NameFull = s_Pfad & \ & s_Name
VarStringKomma$ = ,
->Datei neu anlegen
h = FreeFile
Open s_NameFull For Binary Access Write As #h
b_first = True
For x = 1 To l_rows
VarString$ = ws.Cells(x, l_col).Value
If VarString$ <> Then
If Not b_first Then
Put #h, , VarStringKomma$
Else
b_first = False
End If
Put #h, , VarString$
End If
Next
Close #1
End If
MsgBox (Textfile wurde geschrieben. & vbLf & s_NameFull)
Aufraeumen:
->Objekt-Variablen freigeben
Set ws = Nothing: Set wb = Nothing
End Sub
