26.12.2017, 17:06 (Dieser Beitrag wurde zuletzt bearbeitet: 26.12.2017, 19:04 von norre.)
Hallo Miteinander,
um den Überblick über unsere Kochzeitschriften zu erhalten habe ich die Inhaltsverzeichnisse der Zeitschriften eingescannt und per OCR-Software in eine LibreCalc Tabelle gebracht.
Jetzt könnte man ja schon mal nach einem Rezept suchen.
Allerdings habe ich ein kleines Programm in dem ich meine Gewürzrezepte und ähnliches gespeichert habe so kam die Idee auf ob man nicht auch die Tabelle der Kochzeitschriften da einpflegen könnte.
Das Problem ist dass man in dem Programm für jeden Datensatz ein eigenes Textdokument braucht (und es sind viele)
Hat jemand eine Idee wie ich jeden Datensatz (Zeile) in ein eigenes Textdokument bringe und auch noch vor jeder Zeile dort ein doppelter Doppelpunkt geschrieben wird?
Hier der Screenshot meiner Tabelle
[ATTACH=CONFIG]12965[/ATTACH]
und hier wie es danach im Textdokument aussehen soll
[ATTACH=CONFIG]12966[/ATTACH]
Erstelle eine leere Textdatei, füge den VBS-Code ein, passe die Variable „Pfad“ an
und ändere dann die Erweiterung in ".vbs".
Exportiere die Tabelle als CSV-Datei mit dem Semikolon als Feldtrenner.
Starte die VBS-Datei.
Code:
Dim CSVA
Dim fso, MyFile
Pfad = "C:\temp\corelforum\Norre\Rezepte\"
Set fso = CreateObject("Scripting.FileSystemObject")
CSVA = CSVArray(Pfad & "Rezepte1.csv")
For i = 1 To UBound(CSVA)
Set MyFile = fso.CreateTextFile(Pfad & "Datensatz" & i & ".txt", True)
For k = 0 To UBound(CSVA, 2)
MyFile.WriteLine (":" & CSVA(i, k))
Next
MyFile.Close
Next
Function CSVArray(CSVFile)
Dim comma, quote
comma = ";"
quote = Chr(34)
Dim charPos, charVal
Dim cellPos, colMax, colNum
colMax = -1
Dim cellArray(), cellComplete, cellQuoted, csvRecord
Dim inCsvSys, inCsv, inRow(), rowCount
rowCount = -1
Set inCsvSys = CreateObject("Scripting.FileSystemObject")
Set inCsv = inCsvSys.OpenTextFile(CSVFile, "1", True)
Do While Not inCsv.AtEndOfStream
rowCount = rowCount + 1
ReDim Preserve inRow(rowCount)
inRow(rowCount) = inCsv.ReadLine
Loop
inCsv.Close
If (cellComplete = True) Then
colNum = colNum + 1
cellPos = 0
cellQuoted = False
cellComplete = False
If colNum > colMax Then
colMax = colNum
ReDim Preserve cellArray(rowCount, colMax)
End If
End If
charPos = charPos + 1
cellPos = cellPos + 1
charVal = Mid(csvRecord, charPos, 1)
If (charVal = quote) Then
If (cellPos = 1) Then
cellQuoted = True
charVal = ""
Else
Select Case Mid(csvRecord, charPos + 1, 1)
Case quote
charPos = charPos + 1
Case comma
charPos = charPos + 1
cellComplete = True
End Select
End If
ElseIf (charVal = comma) And (cellQuoted = False) Then
cellComplete = True
End If
If (cellComplete = False) Then
cellArray(r, colNum) = cellArray(r, colNum) & charVal
End If
27.12.2017, 15:28 (Dieser Beitrag wurde zuletzt bearbeitet: 27.12.2017, 15:31 von norre.)
Hallo Koter,
habe doch nicht warten können das auszuprobieren.
Nach den starten der VBS Datei wird die Rezepte1.csv angelegt dann kommt allerdings diese Fehlermeldung
[ATTACH=CONFIG]12968[/ATTACH]
kannst du mir nochmal unter die Arme greifen?
Hier noch mein abgeänderter Pfad
[ATTACH=CONFIG]12969[/ATTACH]
27.12.2017, 17:08 (Dieser Beitrag wurde zuletzt bearbeitet: 27.12.2017, 17:16 von koter.)
Hallo Norre,
meine Schuld, ich habe nicht geschrieben, dass Die CSV-Datei „Rezepte1.csv“ heißen muss.
Du kannst Deine CSV umbenennen oder das Script in Zeile 7 ändern (CSVA = CSVArray(Pfad & "Rezeptarchiv.csv"))
Die vom Script erstellte „Rezepte1.csv“ kannst Du löschen.
Wenn Du noch öfter solche Dateien erzeugen musst, sollten wir uns vielleicht einen eleganteren Weg überlegen.
Gruß
Koter
Nachtrag:
Die Schlamperei geht weiter: Das Script schreibt einen einfachen Doppelpunkt!
Zeile 11 muss auch geändert werden: MyFile.WriteLine ("::" & CSVA(i, k))
Hallo,
jetzt funktioniert es wunderbar, nochmals Danke
Auf den Namen hätte ich laut deinem Screenshot auch selber draufkommen können :oops: und es war eine einmalige Sache die Inhaltsverzeichnisse sind eingeflegt da wird jetzt nichts mehr dazukommen.