-
Notifications
You must be signed in to change notification settings - Fork 0
/
macro1.bas
146 lines (122 loc) · 4.65 KB
/
macro1.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
REM ***** BASIC *****
'---------------------------------------------------------
' READ THIS IS MANDATORY :-)
'
' This Open Office macro will
' - read all the .xls files located in the cFolder defined some line below
' - export each sheet of each file as a separate .csv file, named : filename_sheetname.csv
'
' you need to adapt this file to your needs (directory cFolder, cFieldTypes and maybe other...)
'
' you can adapt it easyly to other imput/ouput formats.
'
'---------------------------------------------------------
Sub Export_CSV
' This is the hardcoded pathname to a folder containing Excel files.
cFolder = "/tmp/ocalc/"
pDoc = ThisComponent
' Get the pathname of each file within the folder.
cFile = Dir$( cFolder + "/*.*" )
Do While cFile <> ""
' If it is not a directory...
If cFile <> "." And cFile <> ".." Then
' If it has the right suffix...
If LCase( Right( cFile, 4 ) ) = ".xls" Then
' Open the document.
oDoc = StarDesktop.loadComponentFromURL(_
ConvertToUrl( cFolder + "/" + cFile ),"_blank", 0, Array() )
'=========
' Options for delimiters in CVS
'cFieldDelimiters = Chr(9)
cFieldDelimiters = ";"
'cTextDelimiter = ""
cTextDelimiter = Chr(34)
cFieldTypes = "2/2/2/2/2/2/2/9/9/9/9/9/9/9/9/9/9"
' options....
' cFieldDelimiters = ",;" ' for either commas or semicolons
' cFieldDelimiters = Chr(9) ' for tab
' cTextDelimiter = Chr(34) ' for double quote
' cTextDelimiter = Chr(39) ' for single quote
' Suppose you want your first field to be numeric, then two text fields, and then a date field....
' cFieldTypes = "1/2/2/3"
' Use 1=Num, 2=Text, 3=MM/DD/YY, 4=DD/MM/YY, 5=YY/MM/DD, 9=ignore field (do not import)
'----------
' Build up the Filter Options string
' From the Developer's Guide
' http://api.openoffice.org/docs/DevelopersGuide/DevelopersGuide.htm
' See section 8.2.2 under Filter Options
' http://api.openoffice.org/docs/DevelopersGuide/Spreadsheet/Spreadsheet.htm#1+2+2+3+Filter+Options
cFieldDelims = ""
For i = 1 To Len( cFieldDelimiters )
c = Mid( cFieldDelimiters, i, 1 )
If Len( cFieldDelims ) > 0 Then
cFieldDelims = cFieldDelims + "/"
EndIf
cFieldDelims = cFieldDelims + CStr(Asc( c ))
Next
If Len( cTextDelimiter ) > 0 Then
cTextDelim = CStr(Asc( cTextDelimiter ))
Else
cTextDelim = "0"
EndIf
cFilterOptions = cFieldDelims + "," + cTextDelim + ",0,1," + cFieldTypes
'=========
' Prepare new filename
cNewName = Left( cFile, Len( cFile ) - 4 )
' Save it in OOo format.
'oDoc.storeToURL( ConvertToUrl( cFolder + "/" + cNewName + ".sxc" ), Array() )
' Loop and selects sheets to save as csv
oSheets = oDoc.Sheets()
aSheetNames = oSheets.getElementNames()
For index=0 to oSheets.getCount() -1
oSheet = oSheets.getByIndex(index)
' Define prefix or suffix to append to filename
appendName = aSheetNames(index) 'define prefix/suffix as the name of the sheet
appendNum = index + 21 ' define prefix/suffix as the number of the sheet
' Choose new filename, with prefix or suffix
'cNewFileName = appendName + "_" + cNewName 'prefix name
'cNewFileName = appendNum + "_" + cNewName ' prefix number
'cNewFileName = cNewName + "_" + appendName ' suffix name
'cNewFileName = cNewName + "_" + appendNum ' suffix number
cNewFileName = appendName
' Replace spaces with underscores in filenames.
cNewFileName = Replace(cNewFileName, " ", "_")
oController = oDoc.GetCurrentController() 'view controller
oController.SetActiveSheet(oSheet) 'switches view to sheet object
' Export it using a filter.
oDoc.StoreToURL( ConvertToUrl( cFolder + "/" + cNewFileName + CFile + ".csv" ),_
Array( MakePropertyValue( "FilterName", "Text - txt - csv (StarCalc)" ),_
MakePropertyValue( "FilterOptions", cFilterOptions ),_
MakePropertyValue( "SelectionOnly", true ) ) )
'Insert sheet
dispatchURL(oDoc,".uno:SelectAll")
dispatchURL(oDoc,".uno:Copy")
'cSheet = oSheet
'pDoc.getSheets.insertByName("newsheet")
'pDoc.Sheets.insertByName("inserted",1)
sc = pDoc.getSheets().getCount()
pDoc.getSheets().insertNewByName(cFile,sc+1)
selectSheetByName(pDoc, cFile)
dispatchURL(pDoc,".uno:Paste")
Next index
' Close the document.
oDoc.dispose()
EndIf
EndIf
cFile = Dir$
Loop
End Sub
Sub dispatchURL(document, aURL)
Dim noProps()
Dim URL As New com.sun.star.util.URL
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
Sub selectSheetByName(document, sheetName)
document.getCurrentController.select(document.getSheets().getByName(sheetName))
End Sub