Code: Select all
Sub merge_Folder_of_CSV_with_same_Headers
If (Not GlobalScope.BasicLibraries.isLibraryLoaded("Tools")) Then GlobalScope.BasicLibraries.LoadLibrary("Tools")
oSFA = createUnoService("com.sun.star.ucb.SimpleFileAccess")
sFolderpath=""
rem---folderpicker
rem to not use the folderpicker set the folder here and uncomment:
rem sFolderpath=converttourl("C:\Users\kai\Desktop")
if sFolderpath="" then
oDialog = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")
If oDialog.Execute() = 1 Then
sFolderpath = oDialog.getDirectory
else
exit sub
end if
end if
if not oSFA.Exists(sFolderpath) then
msgbox "Folder not found!"
exit sub
end if
outputfile = sFolderpath & "/" & "merged.csv"
if fileexists(outputfile) then kill(outputfile)
oTextoutputStream = CreateUnoService("com.sun.star.io.TextOutputStream")
ooutputStream = oSFA.openFileWrite(outputfile)
oTextoutputStream.setOutputStream(ooutputStream)
sFileName=""
sFileName = Dir(sFolderpath & "/", 0)
Do While (sFileName <> "")
if GetFileNameExtension(sFileName)="csv" then
Fileurl=sFolderpath & "/" & sFileName
oTextinputStream = CreateUnoService("com.sun.star.io.TextInputStream")
inputfile = converttourl(Fileurl)
oinputStream = oSFA.openFileRead(inputfile)
oTextinputStream.setInputStream(oinputStream)
stringA = oTextinputStream.readLine()
if Headerwritten=0 then
oTextoutputStream.writestring(stringA & chr(13) & chr(10))
Headerwritten=1
end if
do while oTextinputStream.isEOF()=0
stringA = oTextinputStream.readLine()
oTextoutputStream.writestring(stringA & chr(13) & chr(10))
loop
oTextinputStream.closeInput
end if
sFileName = Dir()
loop
oTextoutputStream.closeOutput()
msgbox "Saved: " & convertfromurl(outputfile)
OpenCSVinCalc(outputfile)
End Sub
rem-----for opening in Calc
Sub OpenCSVinCalc(Url)
Dim oDocument as Object
fnURL=ConvertToURL(Url)
'Create new document and import data
oDocument = StarDesktop.LoadComponentFromURL( fnURL, "_blank", 0, _
Array(MakePropertyValue( "FilterName", "Text - txt - csv (StarCalc)" ), _
MakePropertyValue( "FilterOptions", "59,34,76,1,1" )
End Sub
Function MakePropertyValue( Optional cName As String, Optional uValue ) As com.sun.star.beans.PropertyValue
oPropertyValue = createUnoStruct( "com.sun.star.beans.PropertyValue" )
If Not IsMissing( cName ) Then
oPropertyValue.Name = cName
EndIf
If Not IsMissing( uValue ) Then
oPropertyValue.Value = uValue
EndIf
MakePropertyValue() = oPropertyValue
End Function