Spalten exportieren als ASCII *.txt

Viktor · 2006-01-07T14:50:36+00:00

Hallo! Ist es möglich durch einen klick auf einen VBA Button einen Bereich (2Spalten, sagen wir mal z.B. B4:C28) in eine TXT Datei zu exportieren, die beim Klick auch gleich erstellt und abgespeichert wird? Wenn ja - hat jemand dazu ein Codebeispiel? Vielen Dank schonmal im Voraus! Viktor

Hallo, ist eigentlich ohne Probleme möglich: hier mal ein Beispiel, aber da werden für die Asciiausgabe noch bestimmte forderungen gestellt(spaltenweise):


Sub aufbereiten()
Dim Dateiname As String, DateiNr As Integer
Dat = InputBox("Bitte Dateinamen angeben (ohne Extension)")
If Dat = "" Or Len(Dat) > 8 Then MsgBox ("es wird keine Datei angelegt!"), vbOKOnly: Exit Sub
Dateiname = Dat & ".pol"
anzahl = Sheets("Geograflin").Range("j1").Value
DateiNr = FreeFile
Open Dateiname For Output As DateiNr
For i = 1 To anzahl
wert1 = Cells(i, 2).Value
l = Len(wert1)
Do While l < 13
wert1 = wert1 & " "
l = Len(wert1)
Loop
wert2 = Cells(i, 3).Value
l = Len(wert2)
If wert2 = "R" Then
wert2 = Cells(i, 5).Value
l = Len(wert2)
Do While l < 13
wert2 = wert2 & " "
l = Len(wert2)
Loop
Else
Do While l < 13
wert2 = wert2 & " "
l = Len(wert2)
Loop
End If
code = Cells(i, 6).Value
Print #DateiNr, wert1 & code & "   1   0" & Chr(10) & wert2 & code & "   1   0" & Chr(10)
Next i
Close DateiNr
End Sub

schau es dir, einziger Nachteil bei schon vorhandener Datei wird diese ohne Rücksicht überschrieben, wenn du mit diesem Beispiel nicht klar kommst dann schreib ruhig nochmal und insbesondere, welche Zewllen du in Excel ausgeben wills, vielleicht ein kleines Beispiel dazu.
Gruss WS

Hallo
Markiere den Bereich den du exportieren willst, und löse das Makro aus
Option Explicit

Sub export_selected_Range_and_save_as_TXT()
    '(C) by Ramses
    'Exportiert einen ausgewählten Bereich in ein zu definierendes Textfile
    Dim i As Integer, n As Integer, maxExpCol As Integer, QE As Integer
    Dim StartRow As Integer, StartCol As Integer, selRow As Integer, selCol As Integer
    Dim myC As Range
    Dim expFolder As String, expFileName As String
    Dim myDiv As String, tmpExpText As String, expText As String
    'Maximal zu exportierende Spalten
    'Dieser Parameter ist anzupassen, um unterschiedliche Bereich
    'in ein einheitliches Exportformat zu bringen
    maxExpCol = 25
    'Default Pfad incl abschliessendem Backslash
    expFolder = "C:\Temp\"
    'Standard Name für TextExportFile
    expFileName = "Koordinaten.txt"
    '************************************************
    'Ab hier keine Änderungen mehr vornehmen
    'Trennzeichen für das Textfile
    myDiv = ";"
    If Selection.Columns.Count > maxExpCol Then
        MsgBox "Maximal zu exportierende Spaltenzahl überschritten"
        Exit Sub
    End If
    'Starbereich festlegen
    StartRow = Selection.Range("A1").Row
    StartCol = Selection.Range("A1").Column
    'Scheifenparameter initialisieren
    selRow = Selection.Rows.Count
    selCol = Selection.Columns.Count
    For i = StartRow To StartRow + selRow
        tmpExpText = ""
        For n = StartCol To StartCol + selCol
            tmpExpText = tmpExpText & Cells(i, n).Text & myDiv
        Next n
        'Exportfile auf erforderliche Länge bringen
        If Len(tmpExpText) < maxExpCol Then
            For n = Len(tmpExpText) To maxExpCol
                tmpExpText = tmpExpText & myDiv
            Next n
        End If
        expText = expText & tmpExpText & vbCrLf
    Next i
    'Exportfile und Speicherpfad kontrollieren
    expFileName = Application.GetSaveAsFilename(InitialFileName:=expFolder & expFileName, _
        fileFilter:="Text Files (*.txt), *.txt)", Title:="Exportpfad definieren")
    If Dir(expFileName) <> "" Then
        QE = MsgBox("Sollen die Daten an die existierende Datei angehängt werden," & vbCrLf & _
            "oder soll die Datei überschrieben werden ?" & vbCrLf & vbCrLf & _
            "JA = Anhängen" & vbCrLf & "NEIN = Datei überschreiben" & vbCrLf & "ABBRECHEN = Abbrechen", _
            vbYesNoCancel + vbCritical + vbDefaultButton1, "Exportverhalten definieren")
        If QE = vbCancel Then Exit Sub
        If QE = vbYes Then
            'Daten anhängen
            Open expFileName For Append As #1
            Print #1, expText
            Close #1
        Else
            'Daten überschreiben
            Open expFileName For Output As #1
            Print #1, expText
            Close #1
        End If
    Else
        'Daten erstmalig schreiben
        Open expFileName For Output As #1
        Print #1, expText
        Close #1
    End If
    MsgBox "Daten exportiert"
End Sub

Der Export ist in diesem Beispiel auf 25 Spalten begrenzt, aber das sollte reichen ;-)
Gruss Rainer

Spalten exportieren als ASCII *.txt

Forumthread: Spalten exportieren als ASCII *.txt

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Spalten exportieren als ASCII *.txt

Forumthread: Spalten exportieren als ASCII *.txt

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread