| View previous topic :: View next topic |
| Author |
Message |
neotoma
Newbie
Joined: 26 Feb 2004
Posts: 1
Location: Germany, Mechernich
|
 Posted: Thu Feb 26, 2004 10:26 am Post subject: Save all Sheets as CSV |
 |
|
Hi,
here is some basic code to store all sheets as csv-files, with the Sheetname as Filename.
I
| Code: |
REM ***** BASIC *****
'******************************************************************
'This is a simple Library to save all Sheets of a Spreadsheet
'as CSV-File. It fits my needs. But if you improve this library,
'please make it public (OO-Forum) !
'
'Author: Michael Taupitz
'email: mitaco@gmx.net
'date : 25.2.2004
'******************************************************************
Sub Main
SaveAllToCSV
End Sub
Sub SaveAllToCSV()
Dim i, iAccept as Integer
Dim strPath,sPath as String
Dim oFolderDialog,oUcb,oDocSheets,oSheet as Object
'Get the Sheets !
oDocSheets = StarDesktop.CurrentFrame.Controller.Model.Sheets
'Get the 'Work'-Path
strPath = ConvertFromUrl("/") 'GetPathSettings("Work")) '"file:///D:/own/mycd/"
'Start the FolderPicker
'Note: The following services have to be called in the following order
' because otherwise Basic does not remove the FileDialog Service
oFolderDialog = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")
oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
oFolderDialog.SetDisplayDirectory(strPath)
iAccept = oFolderDialog.Execute()
If iAccept = 1 Then
sPath = oFolderDialog.GetDirectory()
If oUcb.Exists(sPath) Then
strPath = ConvertFromUrl(sPath)
End If
End If
'Iterate through the Sheets, and save everyone with its own name (sheetname)
For i = 0 To oDocSheets.Count-1
oSheet = oDocSheets(i)
saveAsCSV(oSheet.Name, strPath & oSheet.Name & ".csv")
Next
end sub
'******************************************************************
'This Subroutine selects a sheet by name, selects all (using the dispatcher)
'walk trough the rows and columns and saves it with the given Name
'
' sheetName = Name of the Sheet
' outURL = Url to Save the CSV
Sub saveAsCSV(sheetName$,outURL$)
Dim dispatcher,document as object
Dim selProps(0) as new com.sun.star.beans.PropertyValue
Dim firstDoc,oSelect,oColumn,oRow as Object
Dim iNumber,nr,nc as Integer
Dim strOut as String
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
iNumber = FreeFile
firstDoc = ThisComponent
selectSheetByName(firstDoc, sheetName)
selProps(0).Name = "Sel"
selProps(0).Value = false
dispatcher.executeDispatch(document, ".uno:GoToStart", "", 0, selProps())
selProps(0).Value = true
dispatcher.executeDispatch(document, ".uno:GoToEndOfData", "", 0, selProps())
' dispatchURL(firstDoc,".uno:SelectAll")
oSelect=firstDoc.CurrentSelection
oColumn=oSelect.Columns
oRow=oSelect.Rows
Open outURL For Output As #iNumber
For nr = 0 To oRow.getCount-1
strOut = ""
For nc= 0 To oColumn.getCount-1
strOut = strOut & oSelect.getCellByPosition (nc,nr).String & ";"
Next nc
Print #iNumber, strOut
Next nr
Close #iNumber
end sub
Sub selectSheetByName(document, sheetName)
document.getCurrentController.select(document.getSheets().getByName(sheetName))
End Sub
Sub dispatchURL(document, aURL)
Dim noProps()
Dim URL as new com.sun.star.util.URL
Dim frame,transf,disp as Object
frame = document.getCurrentController().getFrame()
URL.Complete = aURL
transf = createUnoService("com.sun.star.util.URLTransformer")
transf.parseStrict(URL)
disp = frame.queryDispatch(URL, "", com.sun.star.frame.FrameSearchFlag.SELF _
OR com.sun.star.frame.FrameSearchFlag.CHILDREN)
disp.dispatch(URL, noProps())
End Sub
|
neotoma |
|
| Back to top |
|
 |
omarbautistag
Newbie
Joined: 07 Jun 2008
Posts: 1
Location: Dominican Republic
|
| Posted: Sat Jun 07, 2008 10:39 am Post subject: A correction |
|
|
Hello:
I had a little problem with that code using OpenOffice 2.3.0. I edit the code above to precise the path of the csv output. I changed the line:
| Code: |
saveAsCSV(oSheet.Name, strPath & oSheet.Name & ".csv")
|
To:
| Code: |
saveAsCSV(oSheet.Name, strPath & "/" & oSheet.Name & ".csv")
|
The hole code is the following:
| Code: |
REM ***** BASIC *****
'******************************************************************
'This is a simple Library to save all Sheets of a Spreadsheet
'as CSV-File. It fits my needs. But if you improve this library,
'please make it public (OO-Forum) !
'
'Author: Michael Taupitz
'email: mitaco@gmx.net
'date : 25.2.2004
'Little correction: Omar Bautista González
'email: omarbautistag@gmail.com, omar@codigolibre.org
'date : 07.Jun.2008
'******************************************************************
Sub Main
SaveAllToCSV
End Sub
Sub SaveAllToCSV()
Dim i, iAccept as Integer
Dim strPath,sPath as String
Dim oFolderDialog,oUcb,oDocSheets,oSheet as Object
'Get the Sheets !
oDocSheets = StarDesktop.CurrentFrame.Controller.Model.Sheets
'Get the 'Work'-Path
strPath = ConvertFromUrl("/") 'GetPathSettings("Work")) '"file:///D:/own/mycd/"
'Start the FolderPicker
'Note: The following services have to be called in the following order
' because otherwise Basic does not remove the FileDialog Service
oFolderDialog = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")
oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
oFolderDialog.SetDisplayDirectory(strPath)
iAccept = oFolderDialog.Execute()
If iAccept = 1 Then
sPath = oFolderDialog.GetDirectory()
If oUcb.Exists(sPath) Then
strPath = ConvertFromUrl(sPath)
End If
End If
'Iterate through the Sheets, and save everyone with its own name (sheetname)
For i = 0 To oDocSheets.Count-1
oSheet = oDocSheets(i)
'saveAsCSV(oSheet.Name, strPath & oSheet.Name & ".csv")
saveAsCSV(oSheet.Name, strPath & "/" & oSheet.Name & ".csv") ' here is my edition: "/"
Next
end sub
'******************************************************************
'This Subroutine selects a sheet by name, selects all (using the dispatcher)
'walk trough the rows and columns and saves it with the given Name
'
' sheetName = Name of the Sheet
' outURL = Url to Save the CSV
Sub saveAsCSV(sheetName$,outURL$)
Dim dispatcher,document as object
Dim selProps(0) as new com.sun.star.beans.PropertyValue
Dim firstDoc,oSelect,oColumn,oRow as Object
Dim iNumber,nr,nc as Integer
Dim strOut as String
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
iNumber = FreeFile
firstDoc = ThisComponent
selectSheetByName(firstDoc, sheetName)
selProps(0).Name = "Sel"
selProps(0).Value = false
dispatcher.executeDispatch(document, ".uno:GoToStart", "", 0, selProps())
selProps(0).Value = true
dispatcher.executeDispatch(document, ".uno:GoToEndOfData", "", 0, selProps())
' dispatchURL(firstDoc,".uno:SelectAll")
oSelect=firstDoc.CurrentSelection
oColumn=oSelect.Columns
oRow=oSelect.Rows
Open outURL For Output As #iNumber
For nr = 0 To oRow.getCount-1
strOut = ""
For nc= 0 To oColumn.getCount-1
strOut = strOut & oSelect.getCellByPosition (nc,nr).String & ";" ' Necesito transfomarlo a TAB, luego.
Next nc
Print #iNumber, strOut
Next nr
Close #iNumber
end sub
Sub selectSheetByName(document, sheetName)
document.getCurrentController.select(document.getSheets().getByName(sheetName))
End Sub
Sub dispatchURL(document, aURL)
Dim noProps()
Dim URL as new com.sun.star.util.URL
Dim frame,transf,disp as Object
frame = document.getCurrentController().getFrame()
URL.Complete = aURL
transf = createUnoService("com.sun.star.util.URLTransformer")
transf.parseStrict(URL)
disp = frame.queryDispatch(URL, "", com.sun.star.frame.FrameSearchFlag.SELF _
OR com.sun.star.frame.FrameSearchFlag.CHILDREN)
disp.dispatch(URL, noProps())
End Sub |
This is a helpfull work, thanks to neotoma. |
|
| Back to top |
|
|
tchule
General User
Joined: 20 Feb 2009
Posts: 5
|
| Posted: Fri Feb 20, 2009 2:43 am Post subject: |
|
|
Thanks a lot ! Very Helpful.
I have one question, I'm a beginner in macro usage. I'm using this macro to generate some CSV files that are ready to import in a database.
I have a problem with UTF-8 encoding (character ü is exported as UTF-16 instead of UTF-8 if i'm not wrong).
As you're not using the "storeToURL" function, you cannot use the FilterFlags property. Do you have an idea of how we could convert the characters ?
Thanks again,
Tchule |
|
| Back to top |
|
|
RAMPRASADAP
General User
Joined: 18 Apr 2009
Posts: 6
|
| Posted: Mon Apr 20, 2009 11:36 pm Post subject: I get property or method not found |
|
|
I this this must be a common error
I get property or method not found for
| Code: |
oDocSheets = StarDesktop.CurrentFrame.Controller.Model.Sheets
|
How do I load this library ? |
|
| Back to top |
|
|
tchule
General User
Joined: 20 Feb 2009
Posts: 5
|
| Posted: Mon May 18, 2009 4:03 am Post subject: |
|
|
Hello,
I've been having a problem with OpenOffice 3.1. On some of my sheets the end of the data is not correctly detected.
I've replaced the following line:
| Code: |
dispatcher.executeDispatch(document, ".uno:GoToEndOfData", "", 0, selProps())
|
With these ones:
| Code: |
dispatcher.executeDispatch(document, ".uno:GoDownToEndOfData", "", 0, selProps())
dispatcher.executeDispatch(document, ".uno:GoRightToEndOfData", "", 0, selProps())
|
This forces me to be sure that all the cells are filled on the last line of the sheet but it works. |
|
| Back to top |
|
|
tchule
General User
Joined: 20 Feb 2009
Posts: 5
|
| Posted: Wed Sep 15, 2010 4:37 am Post subject: |
|
|
Finally, thanks to Andrew's Macro document I've found a way to export correctly in UTF-8.
| Code: |
REM ***** BASIC *****
'
' Cf http://www.oooforum.org/forum/viewtopic.phtml?t=6286
'
'******************************************************************
'This is a simple Library to save all Sheets of a Spreadsheet
'as CSV-File. It fits my needs. But if you improve this library,
'please make it public (OO-Forum) !
'
'Author: Michael Taupitz
'email: mitaco@gmx.net
'date : 25.2.2004
'******************************************************************
Sub Main
SaveAllToCSV
End Sub
Sub SaveAllToCSV()
Dim i, iAccept as Integer
Dim docPath,strPath,sPath as String
Dim oFolderDialog,oUcb,oDocSheets,oSheet as Object
'Get the Sheets !
oDocSheets = StarDesktop.CurrentFrame.Controller.Model.Sheets
'Get the document path
docPath = ThisComponent.getURL
docPath = Left( docPath, Len( docPath ) - 12 )
strPath = ConvertFromUrl(docPath)
'Start the FolderPicker
'Note: The following services have to be called in the following order
' because otherwise Basic does not remove the FileDialog Service
'oFolderDialog = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")
'oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
'oFolderDialog.SetDisplayDirectory(strPath)
'iAccept = oFolderDialog.Execute()
'If iAccept = 1 Then
' sPath = oFolderDialog.GetDirectory()
' If oUcb.Exists(sPath) Then
' strPath = ConvertFromUrl(sPath)
' End If
'End If
'Iterate through the Sheets, and save everyone with its own name (sheetname)
For i = 0 To oDocSheets.Count-1
oSheet = oDocSheets(i)
saveAsCSV(oSheet.Name, strPath & oSheet.Name & ".csv")
Next
end sub
'******************************************************************
'This Subroutine selects a sheet by name, selects all (using the dispatcher)
'walk trough the rows and columns and saves it with the given Name
'
' sheetName = Name of the Sheet
' outURL = Url to Save the CSV
Sub saveAsCSV(sheetName$,outURL$)
Dim dispatcher,document as object
Dim selProps(0) as new com.sun.star.beans.PropertyValue
Dim firstDoc,oSelect,oColumn,oRow as Object
Dim iNumber,nr,nc as Integer
Dim strOut as String
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
fileAccessService = createUnoService("com.sun.star.ucb.SimpleFileAccess")
textOutputStream = createUnoService("com.sun.star.io.TextOutputStream")
iNumber = FreeFile
firstDoc = ThisComponent
selectSheetByName(firstDoc, sheetName)
selProps(0).Name = "Sel"
selProps(0).Value = false
dispatcher.executeDispatch(document, ".uno:GoToStart", "", 0, selProps())
selProps(0).Value = true
dispatcher.executeDispatch(document, ".uno:GoDownToEndOfData", "", 0, selProps())
dispatcher.executeDispatch(document, ".uno:GoRightToEndOfData", "", 0, selProps())
oSelect=firstDoc.CurrentSelection
oColumn=oSelect.Columns
oRow=oSelect.Rows
outputStream = fileAccessService.openFileWrite(outURL)
outputStream.truncate()
textOutputStream.setOutputStream(outputStream)
For nr = 1 To oRow.getCount-1 ' nr = 0 si on ne veut pas zapper la ligne d'entête
strOut = ""
For nc = 0 To oColumn.getCount-1
strOut = strOut & oSelect.getCellByPosition (nc,nr).String
If nc <> oColumn.getCount-1 Then strOut = strOut & ";"
Next nc
strOut = strOut & Chr$(13)
textOutputStream.writeString(strOut)
Next nr
textOutputStream.closeOutput()
end sub
Sub selectSheetByName(document, sheetName)
document.getCurrentController.select(document.getSheets().getByName(sheetName))
End Sub
Sub dispatchURL(document, aURL)
Dim noProps()
Dim URL as new com.sun.star.util.URL
Dim frame,transf,disp as Object
frame = document.getCurrentController().getFrame()
URL.Complete = aURL
transf = createUnoService("com.sun.star.util.URLTransformer")
transf.parseStrict(URL)
disp = frame.queryDispatch(URL, "", com.sun.star.frame.FrameSearchFlag.SELF OR com.sun.star.frame.FrameSearchFlag.CHILDREN)
disp.dispatch(URL, noProps())
End Sub
|
|
|
| Back to top |
|
|
tchule
General User
Joined: 20 Feb 2009
Posts: 5
|
| Posted: Mon May 02, 2011 5:04 am Post subject: |
|
|
To avoid stopping on empty cells, do the selection from the bottom-left to the top-right corner.
Thanks Sylvain for the patch.
| Code: | REM ***** BASIC *****
'
' Cf http://www.oooforum.org/forum/viewtopic.phtml?t=6286
'
'******************************************************************
'This is a simple Library to save all Sheets of a Spreadsheet
'as CSV-File. It fits my needs. But if you improve this library,
'please make it public (OO-Forum) !
'
'Author: Michael Taupitz
'email: mitaco@gmx.net
'date : 25.2.2004
'******************************************************************
Sub Main
SaveAllToCSV
End Sub
Sub SaveAllToCSV()
Dim i, iAccept as Integer
Dim docPath,strPath,sPath as String
Dim oFolderDialog,oUcb,oDocSheets,oSheet as Object
'Get the Sheets !
oDocSheets = StarDesktop.CurrentFrame.Controller.Model.Sheets
'Get the document path
docPath = ThisComponent.getURL
docPath = Left( docPath, Len( docPath ) - 12 )
strPath = ConvertFromUrl(docPath)
'Iterate through the Sheets, and save everyone with its own name (sheetname)
For i = 0 To oDocSheets.Count-1
oSheet = oDocSheets(i)
saveAsCSV(oSheet.Name, strPath & oSheet.Name & ".csv")
Next
end sub
'******************************************************************
'This Subroutine selects a sheet by name, selects all (using the dispatcher)
'walk trough the rows and columns and saves it with the given Name
'
' sheetName = Name of the Sheet
' outURL = Url to Save the CSV
Sub saveAsCSV(sheetName$,outURL$)
Dim dispatcher,document as object
Dim selProps(0) as new com.sun.star.beans.PropertyValue
Dim firstDoc,oSelect,oColumn,oRow as Object
Dim iNumber,nr,nc as Integer
Dim strOut as String
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
fileAccessService = createUnoService("com.sun.star.ucb.SimpleFileAccess")
textOutputStream = createUnoService("com.sun.star.io.TextOutputStream")
iNumber = FreeFile
firstDoc = ThisComponent
selectSheetByName(firstDoc, sheetName)
selProps(0).Name = "Sel"
selProps(0).Value = false
dispatcher.executeDispatch(document, ".uno:GoToStart", "", 0, selProps())
dispatcher.executeDispatch(document, ".uno:GoDownToEndOfData", "", 0, selProps())
selProps(0).Value = true
dispatcher.executeDispatch(document, ".uno:GoToStart", "", 0, selProps())
dispatcher.executeDispatch(document, ".uno:GoRightToEndOfData", "", 0, selProps())
oSelect=firstDoc.CurrentSelection
oColumn=oSelect.Columns
oRow=oSelect.Rows
outputStream = fileAccessService.openFileWrite(outURL)
outputStream.truncate()
textOutputStream.setOutputStream(outputStream)
For nr = 1 To oRow.getCount-1 ' nr = 0 si on ne veut pas zapper la ligne d'entête
strOut = ""
For nc = 0 To oColumn.getCount-1
strOut = strOut & oSelect.getCellByPosition (nc,nr).String
If nc <> oColumn.getCount-1 Then strOut = strOut & ";"
Next nc
strOut = strOut & Chr$(13)
textOutputStream.writeString(strOut)
Next nr
textOutputStream.closeOutput()
end sub
Sub selectSheetByName(document, sheetName)
document.getCurrentController.select(document.getSheets().getByName(sheetName))
End Sub
Sub dispatchURL(document, aURL)
Dim noProps()
Dim URL as new com.sun.star.util.URL
Dim frame,transf,disp as Object
frame = document.getCurrentController().getFrame()
URL.Complete = aURL
transf = createUnoService("com.sun.star.util.URLTransformer")
transf.parseStrict(URL)
disp = frame.queryDispatch(URL, "", com.sun.star.frame.FrameSearchFlag.SELF OR com.sun.star.frame.FrameSearchFlag.CHILDREN)
disp.dispatch(URL, noProps())
End Sub |
|
|
| Back to top |
|
|
tchule
General User
Joined: 20 Feb 2009
Posts: 5
|
| Posted: Mon Feb 20, 2012 5:30 am Post subject: |
|
|
For recent version of OpenOffice / LibreOffice
| Code: |
REM ***** BASIC *****
'
' Cf http://www.oooforum.org/forum/viewtopic.phtml?t=6286
'
'******************************************************************
'This is a simple Library to save all Sheets of a Spreadsheet
'as CSV-File. It fits my needs. But if you improve this library,
'please make it public (OO-Forum) !
'
'Author: Michael Taupitz
'email: mitaco@gmx.net
'date : 25.2.2004
'******************************************************************
Sub Main
SaveAllToCSV
End Sub
Sub SaveAllToCSV()
Dim i, iAccept as Integer
Dim docPath,strPath,sPath as String
Dim oFolderDialog,oUcb,oDocSheets,oSheet as Object
'Get the Sheets !
oDocSheets = StarDesktop.CurrentFrame.Controller.Model.Sheets
'Get the document path
docPath = ThisComponent.getURL
docPath = Left( docPath, Len( docPath ) - 12 )
strPath = ConvertFromUrl(docPath)
'Iterate through the Sheets, and save everyone with its own name (sheetname)
For i = 0 To oDocSheets.Count-1
oSheet = oDocSheets(i)
saveAsCSV(oSheet.Name, strPath & oSheet.Name & ".csv")
Next
end sub
'******************************************************************
'This Subroutine selects a sheet by name, selects all (using the dispatcher)
'walk trough the rows and columns and saves it with the given Name
'
' sheetName = Name of the Sheet
' outURL = Url to Save the CSV
Sub saveAsCSV(sheetName$,outURL$)
Dim dispatcher,document as object
Dim selProps(0) as new com.sun.star.beans.PropertyValue
Dim firstDoc,oSelect,endColumn,endRow,oCursor,startColumn,startRow,rangeAddress as Object
Dim iNumber,nr,nc as Integer
Dim strOut as String
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
fileAccessService = createUnoService("com.sun.star.ucb.SimpleFileAccess")
textOutputStream = createUnoService("com.sun.star.io.TextOutputStream")
iNumber = FreeFile
firstDoc = ThisComponent
selectSheetByName(firstDoc, sheetName)
oSheet = thisComponent.currentController.activeSheet
oCursor = oSheet.createCursor
oCursor.GotoEndOfUsedArea(True)
rangeAddress = oCursor.RangeAddress
endColumn = rangeAddress.EndColumn
endRow = rangeAddress.EndRow
startColumn = rangeAddress.StartColumn
startRow = rangeAddress.StartRow
oSelect=firstDoc.CurrentSelection
If (endRow > 0) Then ' Cas où la fiche est vide
outputStream = fileAccessService.openFileWrite(outURL)
outputStream.truncate()
textOutputStream.setOutputStream(outputStream)
For nr = (startRow + 1) To endRow ' nr = 0 si on ne veut pas zapper la ligne d'entête
strOut = ""
For nc = startColumn To endColumn
strOut = strOut & oSelect.getCellByPosition (nc,nr).String
If nc <> endColumn Then strOut = strOut & ";"
Next nc
strOut = strOut & Chr$(13)
textOutputStream.writeString(strOut)
Next nr
textOutputStream.closeOutput()
End If
end sub
Sub selectSheetByName(document, sheetName)
document.getCurrentController.select(document.getSheets().getByName(sheetName))
End Sub
Sub dispatchURL(document, aURL)
Dim noProps()
Dim URL as new com.sun.star.util.URL
Dim frame,transf,disp as Object
frame = document.getCurrentController().getFrame()
URL.Complete = aURL
transf = createUnoService("com.sun.star.util.URLTransformer")
transf.parseStrict(URL)
disp = frame.queryDispatch(URL, "", com.sun.star.frame.FrameSearchFlag.SELF OR com.sun.star.frame.FrameSearchFlag.CHILDREN)
disp.dispatch(URL, noProps())
End Sub |
|
|
| Back to top |
|
|
nitro322
Newbie
Joined: 17 Mar 2012
Posts: 1
|
| Posted: Sat Mar 17, 2012 9:27 pm Post subject: |
|
|
tchule, thank you! I've been searching on and off for something like this for a couple of years and have never been able to get anything to work, due either to outdated macros, recent changes in UNO support in libreoffice (for external scripts), and my own completely unfamiliarity with macros. This is the first one I've ever been able to get to work, and it's already proven extremely useful.
So again, thank you.
After saving my files, though, I found a few bugs, or otherwise unexpected behavior, in your code. I've attached a revised version with three changes:
* The output filename for each CSV file is now "<Original Filename> - <Worksheet Name>.csv" Previously, it was only the first 12 characters of the original filename, and there was no separator between the file and worksheet names
* Each line is now correctly terminated
* Output is quote-encapsulated and comma-delimited, whereas before it was semicolon-delimited
| Code: | REM ***** BASIC *****
'
' Cf http://www.oooforum.org/forum/viewtopic.phtml?t=6286
'
'******************************************************************
'This is a simple Library to save all Sheets of a Spreadsheet
'as CSV-File. It fits my needs. But if you improve this library,
'please make it public (OO-Forum) !
'
'Author: Michael Taupitz
'email: mitaco@gmx.net
'date : 25.2.2004
'******************************************************************
Sub Main
SaveAllToCSV
End Sub
Sub SaveAllToCSV()
Dim i, iAccept as Integer
Dim docPath,strPath,sPath as String
Dim oFolderDialog,oUcb,oDocSheets,oSheet as Object
'Get the Sheets !
oDocSheets = StarDesktop.CurrentFrame.Controller.Model.Sheets
'Get the document path
docPath = ThisComponent.getURL
docPath = Left( docPath, Len( docPath ) - 4 ) & " - "
strPath = ConvertFromUrl(docPath)
'Iterate through the Sheets, and save everyone with its own name (sheetname)
For i = 0 To oDocSheets.Count-1
oSheet = oDocSheets(i)
saveAsCSV(oSheet.Name, strPath & oSheet.Name & ".csv")
Next
end sub
'******************************************************************
'This Subroutine selects a sheet by name, selects all (using the dispatcher)
'walk trough the rows and columns and saves it with the given Name
'
' sheetName = Name of the Sheet
' outURL = Url to Save the CSV
Sub saveAsCSV(sheetName$,outURL$)
Dim dispatcher,document as object
Dim selProps(0) as new com.sun.star.beans.PropertyValue
Dim firstDoc,oSelect,endColumn,endRow,oCursor,startColumn,startRow,rangeAddress as Object
Dim iNumber,nr,nc as Integer
Dim strOut as String
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
fileAccessService = createUnoService("com.sun.star.ucb.SimpleFileAccess")
textOutputStream = createUnoService("com.sun.star.io.TextOutputStream")
iNumber = FreeFile
firstDoc = ThisComponent
selectSheetByName(firstDoc, sheetName)
oSheet = thisComponent.currentController.activeSheet
oCursor = oSheet.createCursor
oCursor.GotoEndOfUsedArea(True)
rangeAddress = oCursor.RangeAddress
endColumn = rangeAddress.EndColumn
endRow = rangeAddress.EndRow
startColumn = rangeAddress.StartColumn
startRow = rangeAddress.StartRow - 1
oSelect=firstDoc.CurrentSelection
If (endRow > 0) Then ' Cas où la fiche est vide
outputStream = fileAccessService.openFileWrite(outURL)
outputStream.truncate()
textOutputStream.setOutputStream(outputStream)
For nr = (startRow + 1) To endRow ' nr = 0 si on ne veut pas zapper la ligne d'entête
strOut = """"
For nc = startColumn To endColumn
strOut = strOut & oSelect.getCellByPosition (nc,nr).String
If nc <> endColumn Then strOut = strOut & ""","""
Next nc
strOut = strOut & """" & Chr$(13) & Chr$(10)
textOutputStream.writeString(strOut)
Next nr
textOutputStream.closeOutput()
End If
end sub
Sub selectSheetByName(document, sheetName)
document.getCurrentController.select(document.getSheets().getByName(sheetName))
End Sub
Sub dispatchURL(document, aURL)
Dim noProps()
Dim URL as new com.sun.star.util.URL
Dim frame,transf,disp as Object
frame = document.getCurrentController().getFrame()
URL.Complete = aURL
transf = createUnoService("com.sun.star.util.URLTransformer")
transf.parseStrict(URL)
disp = frame.queryDispatch(URL, "", com.sun.star.frame.FrameSearchFlag.SELF OR com.sun.star.frame.FrameSearchFlag.CHILDREN)
disp.dispatch(URL, noProps())
End Sub |
|
|
| Back to top |
|
|
RussellEngland
General User
Joined: 17 Nov 2010
Posts: 6
|
| Posted: Mon May 28, 2012 6:47 am Post subject: |
|
|
Works great!
Although it did have a wobbly on a sheet with hidden rows.
So I just highlighted all the rows, clicked "show" and tried again. |
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|
