Hallo Kollegen,

Jetzt hab ich auch mal eine Frage. Ich mach grade ein paar Tests mit dem TextStream-Objekt (Ein Unterobjekt vom FileSystemObjekt). Konkret versuche ich, Binärdaten aus einem String in eine neue Datei (hier z.B. JPG) zu schreiben. Die Daten hole ich zuvor aus einer Original-Datei in den String. Am Ende des Makros öffne ich nochmal die neue Datei und prüfe jedes Byte, ob es auch korrekt angekommen ist.

Und genau da ist mein Problem: Die Größe der neuen Datei entspricht exakt der Größe von der Originalen. Und die Byte-Prüfung ergibt keine Fehler, das heißt: Alle Bytes sind genauso, wie sie sollen. Auch Sonderzeichen wie Chr(0) oder Chr(13) usw. werden korrekt geschrieben.

Trotzdem kann ich die neue JPG-Datei nicht öffnen. Ich erhalten sowohl mit der Windows-FotoAnzeige als auch z.B. mit Paint, die Meldung, dass die Datei beschädigt sei. Wie kann das sein, wenn es sich doch um eine exakte Kopie handelt? Was übersehe ich hier?

PS: Auch eine Dateierstellung über Open For Binary bringt leider nicht den gewünschten Erfolg.

Windows 11, Excel 2019.

Sub ReadTextFileTest()
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
    Dim fs, f, g, s As String, t As String, Datei1 As String, Datei2 As String
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    
    Datei1 = "D:\Pfad\Testbild.JPG"
    Datei2 = "D:\Pfad\Testbild2.JPG"
    
    Set f = fs.OpenTextFile(Datei1, ForReading, False, TristateFalse)
    s = f.readall
    f.Close
    
    WriteToFile Datei2, s
    'Schreibtest2 Datei2, s
    
    
    'Prüfen ob alles angekommen ist.
    Set g = fs.OpenTextFile(Datei2, ForReading, False, TristateFalse)
    t = g.readall
    g.Close
    
    For i = 1 To Len(s)
      If Asc(Mid(s, i, 1)) <> Asc(Mid(t, i, 1)) Then
        Debug.Print "Stelle " & i & ": " & Asc(Mid(s, i, 1)) & " <> " & Asc(Mid(t, i, 1))
      End If
    Next i
    
    MsgBox "Fertig"
    
End Sub
Sub WriteToFile(Datei As String, s As String)
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
    Dim fs, f
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.OpenTextFile(Datei, ForWriting, True, TristateUseDefault)
    f.Write s
    f.Close
End Sub

Sub Schreibtest2(Datei As String, s As String)

    Open Datei For Binary Access Write As #1
      Put #1, , s
    Close #1

End Sub

Gruß Mr. K.