|
Hallo Kevin,
Gewünschte Spalte markieren (sollten es mehrere Spalten sein, wird Programm nicht durchgeführt) und danach "ueberleitung" starten.
Nur den Dateinamen (ohne Pfad und Endung eingeben). Die Datei wird dort gespeichert, wo Datendatei liegt.
Sollte Datei schon existieren, dann kann ein anderer Namen genommen werden, oder die Datei überschrieben werden.
Lg.
Martin
Sub ueberleitung()
Dim pfad As String
Dim auswahl As Range
Set auswahl = Selection
pfad = Application.ActiveWorkbook.Path & "\"
'wenn genau 1 Spalte ausgewähl ist, neue Datei anlegen bzw. alte überschreiben
If auswahl.Columns.Count = 1 Then
Do
sDat = InputBox("Bitte Dateinamen (ohne Pfad + .txt) eingeben", "Dateneingabe")
lp = dOpen(pfad & sDat & ".txt")
Loop While lp <> 1
sDat = sDat & ".txt"
fnr = FreeFile
Open sDat For Output As #fnr
For Each n In auswahl
Print #fnr, n.Value
Next
Close #fnr
MsgBox "Aktion durchgeführt in " & pfad, vbOKOnly + vbInformation, "abgeschlossen"
Else
MsgBox "Bitte nur eine Spalte auswählen", vbOKOnly + vbCritical, "Anwendungsfehler"
End If
End Sub
Function dOpen(name)
'Überprüfung ob Dateiname schon existiert
On Error Resume Next
ausw = 0
fnr = FreeFile
Open name For Input As #fnr
If Err.Number = 53 Then
ausw = 1
GoSub ok
End If
alt = MsgBox("Dieser Name existiert bereits" & Chr(13) & "Soll die Datei überschrieben werden (j/n)", vbYesNo + vbQuestion, "Dateneingabe")
If alt = 6 Then ausw = 1
ok:
Close #fnr
dOpen = ausw
End Function
|