| |
|
|
Sven Bader | Für una Volltextsuche Yo esta Función geschrieben, con Anpassungen funktioniert lo auch con XLSX, PPTX, ODT, ODP, ODS y PAGES. Man muss letztendlich el Expediente entzippen y el korrekte XML en él identifizieren. En XLSX es algo verzweigter.
Profano Kompatibilität: El Unzip funktioniert de X4, davor muss uno se una DLL dafür suchen Utf8_Decode va de X3, davor puede ser se algo con Translate$() zusammenbauen, el zumindest häufige Signo como Umlaute ersetzt.
Proc ReadDocx
Parámetros inputFile$
Declarar content$, filesize&, tempFile$, B#
tempFile$ = $TempDir + "docxopener" + "\\word\\document.xml"
'Entpacken
ifnot (FileExists(inputFile$))
Imprimir inputFile$;" No se ha encontrado!"
Volver
endif
UnZip inputFile$, ($TempDir + "docxopener") ,"word\document.xml"
filesize& = FileSize(tempFile$)
if (filesize& < 0)
Imprimir "Fehler beim Entpacken!"
Volver
endif
'Lesen
Dim B#, filesize& + 1
Asignar #1, tempFile$
OpenRW #1
BlockRead(#1, B#, 0, filesize&)
Borrar #1
Cerrar #1
content$ = String$(B#,0)
'Schön hacer
content$ = Utf8Decode(content$)
content$ = Translate$(content$,"<w:p","\n<w:p")'Paragraph Start DOCX
content$ = Translate$(content$,":p>",":p>\n\n")'Paragraph Ende
content$ = Translate$(content$,":tab/>",":tab/> ")'Tab
content$ = Translate$(content$,":br/>",":br/>\n")'Romper
content$ = Translate$(content$,":line-romper/>",":line-romper/>\n")'Romper
content$ = Translate$(content$," "," ")
Conjunto("RegEx", 1)
content$ = Translate$(content$,"<[^>]*>","")'Strip Tags
Conjunto("RegEx", 0)
content$ = Trim$(content$)
Volver content$
ENDPROC
Cls
messagebox ReadDocx("test.docx") ,"",0
Waitinput
End
|
|
|
| |
|
|