OpenOffice.org Forum at OOoForum.orgThe OpenOffice.org Forum
 
 [Home]   [FAQ]   [Search]   [Memberlist]   [Usergroups]   [Register
 [Profile]   [Log in to check your private messages]   [Log in

Save all Sheets as CSV

 
Post new topic   Reply to topic    OOoForum.org Forum Index -> OpenOffice.org Code Snippets
View previous topic :: View next topic  
Author Message
neotoma
Newbie
Newbie


Joined: 26 Feb 2004
Posts: 1
Location: Germany, Mechernich

PostPosted: Thu Feb 26, 2004 10:26 am    Post subject: Save all Sheets as CSV Reply with quote

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
View user's profile Send private message Visit poster's website
omarbautistag
Newbie
Newbie


Joined: 07 Jun 2008
Posts: 2
Location: Dominican Republic

PostPosted: Sat Jun 07, 2008 10:39 am    Post subject: A correction Reply with quote

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
View user's profile Send private message Visit poster's website MSN Messenger
tchule
General User
General User


Joined: 20 Feb 2009
Posts: 5

PostPosted: Fri Feb 20, 2009 2:43 am    Post subject: Reply with quote

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
View user's profile Send private message
RAMPRASADAP
General User
General User


Joined: 18 Apr 2009
Posts: 6

PostPosted: Mon Apr 20, 2009 11:36 pm    Post subject: I get property or method not found Reply with quote

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
View user's profile Send private message
tchule
General User
General User


Joined: 20 Feb 2009
Posts: 5

PostPosted: Mon May 18, 2009 4:03 am    Post subject: Reply with quote

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
View user's profile Send private message
tchule
General User
General User


Joined: 20 Feb 2009
Posts: 5

PostPosted: Wed Sep 15, 2010 4:37 am    Post subject: Reply with quote

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
View user's profile Send private message
tchule
General User
General User


Joined: 20 Feb 2009
Posts: 5

PostPosted: Mon May 02, 2011 5:04 am    Post subject: Reply with quote

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
View user's profile Send private message
tchule
General User
General User


Joined: 20 Feb 2009
Posts: 5

PostPosted: Mon Feb 20, 2012 5:30 am    Post subject: Reply with quote

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
View user's profile Send private message
nitro322
Newbie
Newbie


Joined: 17 Mar 2012
Posts: 1

PostPosted: Sat Mar 17, 2012 9:27 pm    Post subject: Reply with quote

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
View user's profile Send private message
RussellEngland
General User
General User


Joined: 17 Nov 2010
Posts: 6

PostPosted: Mon May 28, 2012 6:47 am    Post subject: Reply with quote

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
View user's profile Send private message
omarbautistag
Newbie
Newbie


Joined: 07 Jun 2008
Posts: 2
Location: Dominican Republic

PostPosted: Tue May 28, 2013 5:14 pm    Post subject: Glad to work collectively with all of you. Reply with quote

I'm glad to see that we are effectively maintaining this public and helpful tool.

I took a copy of the last adaptation for LibreOffice and it worked fine for my using semicolons as separators in line 87:

Code:
         If nc <> endColumn Then strOut = strOut & """;"""


Regards,
Back to top
View user's profile Send private message Visit poster's website MSN Messenger
userloser
Newbie
Newbie


Joined: 23 Aug 2013
Posts: 3

PostPosted: Fri Aug 23, 2013 7:57 am    Post subject: minor bugfix Reply with quote

The code above generates invalid csv because quotes inside cells are not properly escaped. It is also hard to set encodings, delimiters and whatnot.

A better way to do the same would be to just use the export filter and have it do all the hard work.

If someone wishes, you can parametrize the export settings string.

Code:

REM  *****  BASIC  *****

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) !
'
'Orig. author: Michael Taupitz
'email:   mitaco@gmx.net
'date :     25.2.2004
'
'userloser fixed some bugs on Aug 23 2013
'******************************************************************

Option Explicit

' saves sheets in the doc directory, but
' without appending the document filename
Sub Main
   SaveAllToCSV()
End Sub

' example appending a prefix to
' the csv file name
Sub Main1
   SaveAllToCSV("prefix - ")
End Sub


' This procedure iterates over the spreadsheets in
' a Calc file and save each to a new file named
' $basename/${newFileNamePrefix}$sheet_name.csv

Sub SaveAllToCSV(Optional newFileNamePrefix as String)

   Dim i as Integer
   Dim path as String
   Dim newFile as String
   Dim oDocSheets,oSheet as Object
   
   ' setup the options of the export csv filter
   ' for details see http://wiki.openoffice.org/wiki/Documentation/DevGuide/Spreadsheets/Filter_Options
   
   Dim filterArgs(1) as new com.sun.star.beans.PropertyValue
   filterArgs(0).Name  = "FilterName"
   filterArgs(0).Value = "Text - txt - csv (StarCalc)"
   filterArgs(1).Name  = "FilterOptions"
   ' field sep(44 - comma), txt delim (34 - dblquo), charset (0 = system, 76 - utf8), first line (1 or 2)
   filterArgs(1).Value = "44,34,76,1"

   ' get the document path from the name
   path = ConvertFromUrl(Dirname)
   
   'Iterate through the spreadsheets in a file and save each to a
   ' $filename/$sheet_name.csv
   oDocSheets = StarDesktop.CurrentFrame.Controller.Model.Sheets
   For i = 0 To oDocSheets.Count-1
        'retrieve sheet reference, set as active sheet
        oSheet = oDocSheets(i)
        ThisComponent.CurrentController.setActiveSheet(oSheet)
       
        ' make the filename
        if ismissing(newFileNamePrefix) then
              newFile = ConvertToUrl(path & oSheet.Name & ".csv")
        else
              newFile = ConvertToUrl(path & newFileNamePrefix & oSheet.Name & ".csv")
        end if

        ' save csv to disk file newFile
          ThisComponent.storeAsUrl(newFile, filterArgs)
   Next

End Sub

' stolen from the forums, works like a buggy dirname(1)
' but does not take argument, works with
' the url of the currently open document instead

Function Dirname

   Dim odoc as object
   Dim fileName As String
   Dim n As Long

    odoc = ThisComponent
    fileName = odoc.url

    For n = Len( fileName ) To 1 Step -1
      If Mid( fileName, n, 1 ) = "/" Then Exit For
    Next n

   ' assign var to func name to return value
   ' oh my
   Dirname = Left( fileName, n )

End Function


Works with 4.0.0 here.

Cheers,
Back to top
View user's profile Send private message
krcabrer
Newbie
Newbie


Joined: 27 Oct 2013
Posts: 1

PostPosted: Sun Oct 27, 2013 1:05 pm    Post subject: My libroffice (ver 4.1 ubuntu) complains property not found Reply with quote

I have to change this line

Code:
oDocSheets = StarDesktop.CurrentFrame.Controller.Model.Sheets


for this code:

Code:
oDocSheets = ThisComponent.Sheets


I don't understand why should I have to make such a change.

I'm working on libreoffice 4.1.2.3.

Thank you for your help.
Back to top
View user's profile Send private message
Sammy76
Newbie
Newbie


Joined: 25 Dec 2013
Posts: 1

PostPosted: Wed Dec 25, 2013 9:58 pm    Post subject: Reply with quote

Great job.
_________________
DFGH
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    OOoForum.org Forum Index -> OpenOffice.org Code Snippets All times are GMT - 8 Hours
Page 1 of 1

 
Jump to:  
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