Alle Zellen einer Spalte in einzelne Textdateien speichern

Sub XML_erzeugen()
Dim strDateiname As String, strPath As String
Dim i As Long, lngZeile As Long
strPath = InputBox( _
prompt:="Verzeichnis eintragen in welchem die Dateien abgelegt werden sollen:",  _
Default:="D:\")
If Right(strPath, 1)  "\" Then strPath = strPath & "\"
strDateiname = "txt_dateiname.xml" 'Dateinamen mit Dateiendung eintragen
lngZeile = Range("I" & Rows.Count).End(xlUp).Row
Open strPath & strDateiname For Output As #1
For i = 1 To lngZeile
Print #1, Cells(i, 9).Value
Next i
Close #1
End Sub

Sub XML_erzeugen() ' schreibt alle Zellen aus Spalte I(2) in ein xml
Dim intFF As Integer
Dim iZeile As Integer
Dim strDateiname As String
Dim strPath As String
Dim strTemp As String
strPath = InputBox( _
prompt:="Verzeichnis eintragen in welchem die Dateien abgelegt werden sollen:",  _
Default:="D:\")
If Right(strPath, 1)  "\" Then strPath = strPath & "\"
strDateiname = "Test.txt"
intFF = FreeFile
iZeile = 2                                                ' Variable für Zeilennummer
Open strPath & strDateiname For Output As #intFF       ' Öffnet oder erstellt Textdatei zum  _
hineinschreiben
Do Until Cells(iZeile, 9).Value = ""                   ' Schleife: Laufe solange, bis Zelle  _
leer ist
strTemp = Cells(iZeile, 9)                             ' Zellwert an Zwischenspeicher ü _
bergeben
Print #intFF, strTemp                                  ' Zwischenspeicher in TXTDatei  _
schreiben
iZeile = iZeile + 1                                    ' Zeilenzähler erhöhen
Loop                                                   ' zurück zum Schleifenbeginn
Close #intFF                                           ' schließt die Textdatei
End Sub