Code: Select all
REM ***** BASIC *****
' Main routine
'
' 1. determine your CSV filter options and edit the code line
'(Search FilterOptions)
' 2. run insertCSV2Calc from your target Calc document
Sub insertCSV2Calc
sMakroName = "insertCSV2Calc "
sMakroVersion = "1.5.0 "
sMakroDatum = "20081221 "
oImport2Calc = _
StarDesktop.getCurrentComponent().getCurrentController().getModel()
' Examine whether Macro called is for a Calc Spreadsheet
' load of auxiliary functions library
GlobalScope.BasicLibraries.LoadLibrary( "Tools" )
' File dialog to select the CSV
oFileDialog = _
CreateUnoService( "com.sun.star.ui.dialogs.FilePicker" )
With oFileDialog
.appendFilter( "Text CSV (*.txt;*.csv;*.xls)", "*.txt" )
.appendFilter( "Text (*.txt)", "*.txt" )
.appendFilter( "Text Encoded (*.txt)", "*.fixcc" )
.appendFilter( "Text File (Fixed Width)", "*.fixcc" )
.Title = "006 - Copy" REM select file to import
.setDisplayDirectory( ConvertToURL( "C:\Users\DMRC\Documents\AndyR\OpenOffice\Runonmultiplefiles\") ) REM select directory
' .setDisplayDirectory( ConvertToURL( "/zentrale/2008/data/CSVs/") )
End With
' if selected, and closed with OK
If oFileDialog.execute() = _
com.sun.star.ui.dialogs.ExecutableDialogResults.OK then
' selected file name
sUrl = oFileDialog.Files(0)
' Worksheet query
sSheetName = Inputbox( "Name of the Sheet to insert", _
sMakroName & " -Sheet Name", "new Import data" )
if sSheetName > "" then
' if available: not OK
if oImport2Calc.Sheets().hasByName( sSheetName ) then
MsgBox _
"End the macro: Sheet already exists." & CHR(10) _
& CHR(10) & "Explanation:" _
& CHR(10) & "A Sheet with the name entered exists." _
& CHR(10) & "Therefore no data was imported." _
& CHR(10) & "Makro " & sMakroName & " is now finished." _
, 48 , sMakroName & "Version " & sMakroVersion
Exit Sub
End If
' sheet with given name does not exist:
' check if too much sheet already there
if oImport2Calc.Sheets().getCount() < 255 then
oImport2Calc.Sheets().insertNewByName( sSheetName , _
oImport2Calc.Sheets().getCount() )
else
MsgBox _
"End the macro: Maximum number of sheets." & CHR(10) _
& CHR(10) & "Explanation:" _
& CHR(10) & "This Calc file has the maximum number of CALC sheets:" _
& CHR(10) & "no new sheet for import can be inserted." _
& CHR(10) & "Therefore no data was imported" _
& CHR(10) & "Makro " & sMakroName & " is now finished." _
, 48 , sMakroName & "Version " & sMakroVersion
Exit Sub
End If
Else
msgbox "Table name not known - macro ends without action" _
,, sMakroName & sMakroVersion
Exit Sub
End If
' Object for the new sheet
oNewSheet = _
oImport2Calc.Sheets().getByName( sSheetName )
' Determine Filter
Dim FileProperties(1) As New com.sun.star.beans.PropertyValue
FileProperties(0).Name = "FilterName"
FileProperties(0).Value ="Text - txt - csv (StarCalc)"
FileProperties(1).Name = "44/32/MRG,34,ANSI,1,,0,false,true"
' FilterOptions
'
' >>>>
' insert YOUR filter data here
' >>>>
FileProperties(1).Value ="59/44,34,ANSI,1,"
' Open File
oCSV = _
StarDesktop.loadComponentFromURL( _
sUrl, "_blank", 0, FileProperties())
' Identify the area of data
oSourceSheet = oCSV.Sheets( 0 )
Dim iiColumns as Long
Dim iiRows as Long
iiColumns = _
iC2C_getLastUsedColumn( oSourceSheet )
iiRows = _
iC2C_getLastUsedRow( oSourceSheet )
' pull out all data as an array
oSourceArea = _
oSourceSheet.getCellRangeByPosition( _
0, 0, iiColumns, iiRows )
allData = _
oSourceArea.getDataArray()
' Target area in the same size set
oEndArea = _
oNewSheet.getCellRangeByPosition( _
0, 0, iiColumns, iiRows )
' purely write Data array
oEndArea.setDataArray( allData() )
' CSV file closed
oCSV.close( TRUE )
End If
End Sub
' ========================================================================
' pure: Sheet as Object
' Out: Number of the last row / column (starting from zero)
Function iC2C_getLastUsedColumn(oSheet as Object) as Integer
Dim oCell As Object
Dim oCursor As Object
Dim aAddress As Variant
oCell = oSheet.GetCellbyPosition( 0, 0 )
oCursor = oSheet.createCursorByRange(oCell)
oCursor.GotoEndOfUsedArea(True)
aAddress = oCursor.RangeAddress
iC2C_getLastUsedColumn = aAddress.EndColumn
End Function
Function iC2C_getLastUsedRow(oSheet as Object) as Integer
Dim oCell As Object
Dim oCursor As Object
Dim aAddress As Variant
oCell = oSheet.GetCellbyPosition( 0, 0 )
oCursor = oSheet.createCursorByRange(oCell)
oCursor.GotoEndOfUsedArea(True)
aAddress = oCursor.RangeAddress
iC2C_GetLastUsedRow = aAddress.EndRow
End Function
' =========================
' To determine the filtering options for * your * CSV file: open it
' (from OOo, with File>Open... dialogue, use the Import dialogue, '
' with all the necessary Settings), then run the following routine.
' Note the returned values (copy) and replace the ones coded above
' (search "FilterOptions")
' http://www.oooforum.org/forum/viewtopic.phtml?t=40544
' Villeroy Aug 02, 2006 12:08 am
Sub showFilterOptions
Dim args(),i%
args() = thisComponent.getArgs
for i = 0 to uBound(Args())
if args(i).Name = "FilterOptions" then inputbox "","",args(i).value
next
End Sub
