Hallo!
Ich brauche Hilfe bei meinem VBA proggie, das nicht das Ergebnis produziert, das es soll.
Für euch wahrscheinlich nur eine Kleinigkeit, ich habe keine Ahnung warum's nicht funktioniert.
Ich bin VBA-Gelegenheitsprogrammierer (so alle 2 Jahre irgendeine Kleinigkeit)
Nun sind die 2 Jahre wieder 'rum und wieder musste ein VBA Programm her.
Alles funktioniert prächtig bis auf eine (elende) aber wichtige Kleinigkeit.
Zu dem Programm:
Alles läuft unter Excel 2000 / Win XP Pro SP2 ATHLON 3500+
In einer Excel-tabelle stehen in einer spalte dateinamen (d6, d7...), in der daneben jeweils ein text.
Das proggie greift sich einen "dateinamen" nach dem anderen und auch den danebenstehenden Text
aus der Tabelle und erzeugt soviele TXT-Dateien wie Namen da sind mit dem dazugehörigen inhalt.
Das Wichtige:
In den TXT-Dateien muß als erstes das Wort "Header" in Klammern stehen und in der nächsten
Zeile dann der jeweilige Text.
Realisation:
Ich übergebe meiner String-Variablen (unter anderem) die codes für linefeed und wagenrücklauf.
(Chr(10) & Chr(13))
Das Problem:
Wenn ich in die textdatei sehe, dann stehen dort zwei "Kästchen" wo doch eigentlich das "carriage
return" sein sollte.
Also:
[HEADER]
G-Elke
anstatt das Gewünschte
[HEADER]
G-Elke
Meine Frage:
Was mache ich Falsch bzw wie geht es richtig?
Ich sage jetzt schon mal DANKE für eure Hilfe !!
Hier der Code:
Sub Dateien_Schreiben()
Dim strFileName As String
Dim rngSrc As String
Dim Hdr As String
Hdr = "[HEADER]" & Chr(10) & Chr(13)
Range("d6").Activate
Do Until ActiveCell.Value = ""
strFileName = Application.DefaultFilePath & "\" & ActiveCell.Value
rngSrc = Hdr & ActiveCell.Offset(0, 1).Value
If SaveDataTextFile(rngSrc, strFileName) Then
ActiveCell.Offset(1, 0).Activate
Else
Exit Do
End If
Loop
End Sub
Public Function SaveDataTextFile(ByVal rngSrc As String, _
ByVal sFileName As String) _
As Boolean
Dim FN As Integer
On Error GoTo err_SaveData
FN = FreeFile()
Open sFileName For Output As #FN
Print #FN, rngSrc
strFileText = ""
Close #FN
SaveDataTextFile = True
exit_Func:
On Error GoTo 0
Exit Function
err_SaveData:
MsgBox "Fehler-Nr. " & Err.Number & vbCr & Err.Description, _
vbOKOnly + vbCritical, _
"Schiefgelaufen"
Resume exit_Func
End Function
|