I have a tendency to loose these types of things. So posting here instead of some hard drive that fails down track....
This macro goes into the parameters spreadsheet I have setup and iterates through all sheets and generates necessary records to go into new APM database system I'm building.
I use it for storing all database parameters for a system. This becomes very necessary when there are multiple test environments and you want to roll one out very quickly.
I basically would setup one sheet per parameter table and all parameters are contained within that sheet. The column labels relate to the database table column names, and a little flag tells us if the value is char or int type. With > 180 parameter tables, this makes life a breeze!
Global clipText as String
Sub TestIt()
'insertControlRow
'BuildAPMSQL
'generateInsertsForCurrentSheet
'generateInsertForCurrentRow
GenerateTableDeleteSQL
Dim s as string
Dim t as string
s="Hello'"
t=getCharField(s)
msgbox t
End Sub
Function getCharField(fld$)
Dim tmp$
If IsNull(fld$) Or len(fld$)=0 Then
tmp$=""
Else
tmp$=UCase(fld$)
End If
If tmp$ = "" Or tmp$ = "NULL" Or tmp$ = "(NULL)" Then
getCharField = "NULL"
Else
getCharField = "'" & makeDBSafe(fld$, "'", "''") & "'"
End If
End Function
Function getIntField(field)
Dim tmp As String
tmp = UCase(field)
If tmp = "" Or tmp = "NULL" Or tmp = "(NULL)" Then
getIntField = "NULL"
Else
getIntField = field
End If
End Function
Function makeDBSafe(str$)
dim a
Dim c$
Dim tmp$
For a=1 to len(str$)
c$=Mid(str$,a,1)
If c$="'" Then
tmp$=tmp$ & "''"
Else
tmp$=tmp$ & c$
End If
next
makeDBSafe = tmp$
End Function
Function testMe()
testMe="Hello"
End Function
Function testCell(cell)
testCell="Hello" + cell
End Function
Function ConvertBillCodeToCustomerType(fld$)
dim bcc$
bcc$=mid(fld$,3,1)
If bcc$="C" Then
ConvertBillCodeToCustomerType="NOR"
ElseIf bcc$="S" Then
ConvertBillCodeToCustomerType="STF"
Else
ConvertBillCodeToCustomerType="NULL"
End If
End Function
Function ConvertBillCodeToSubproduct(fld$)
dim ct$
ct$=left(fld$,1)
if ct$="S" Then
ct$="C"
End If
ConvertBillCodeToSubproduct="V" + ct$
End Function
function GetSheetName()
GetSheetName = getCurrentSheet().getName()
end function
function getCurrentSheet()
getCurrentSheet = ThisComponent.getCurrentController.getActiveSheet
end function
function getCurrentRow()
oCell = ThisComponent.getCurrentController().getSelection().getCellByPosition(0,0)
rowInt = oCell.getCellAddress.Row
getCurrentRow = getCurrentSheet().getRows.getByIndex(rowInt)
end function
Function makeCurrentPath()
currentPath = ThisComponent.url
i = len(currentPath)
For n = Len( currentPath ) To 1 Step -1
If Mid( currentPath, n, 1 ) = "/" Then Exit For
Next n
makeCurrentPath = left(currentPath, n)
End Function
function BuildXMLTableDefinitions()
'iterate over all sheets
Dim oSheet As Object
Dim eSheets As Object
Dim oRow as Object
Dim oColumn as Object
Dim textFile as Object
StatusText "Building XML tables now"
eSheets = ThisComponent.getSheets.createEnumeration
f1 = FreeFile()
currentPath=makeCurrentPath() & "tablebuilder.xml"
Open currentPath for output as #f1
print #f1, "" "
'Skip the _CTL sheet
While eSheets.hasMoreElements
oSheet = eSheets.nextElement()
'Only non control sheets please :)
if left(oSheet.getName,1) <> "_" Then
StatusText "Generating Table " & oSheet.getName
' here you can work your sheet
print #f1, ""
"
print #f1, "" "
for a = 0 to 50
oCell= oSheet.getCellByPosition(a, 1)
txt = oCell.String
if len(txt) > 0 Then
print #f1, "" & txt & " "
Else
Exit For
End If
next
print #f1, "
for b = 1 to 500
if len(oSheet.getCellByPosition(0,b).String)=0 Then Exit For
print #f1, "" "
for c = 0 to a
oCell= oSheet.getCellByPosition(c, b)
txt = oCell.String
if len(txt) > 0 Then
print #f1, " " & xmlSafe(txt) & ""
Else
Exit For
End If
next
print #f1, "
next
print #f1, "
End If
Wend
StatusText "Completed..."
print #f1, "
close #f1
msgbox "File is created and is at " & currentPath
end function
function xmlSafe(txt) As String
If txt="(null)" Then
xmlSafe = "NULL"
Exit Function
End If
newTxt = ""
for a=1 to len(txt)
char1 = mid(txt, a, 1)
select case char1
case "<" newTxt = newTxt & "<" case "&" newTxt = newTxt & "&" case else newTxt = newTxt & char1 End Select Next xmlSafe = newTxt end function 'Generates all table deletes 'Does it in reverse order to hopefully ensure all data gets deleted Public function GenerateTableDeleteSQL() Dim oSheet As Object Dim eSheets As Object eSheets = ThisComponent.getSheets.createEnumeration lastNumber = 10 Dim textFile as Object f1 = FreeFile() currentPath=makeCurrentPath() & "fulldeletes.sql" Open currentPath for output as #f1 print #f1, "-- Table Deletion for MAPS WOW Parameter Tables" print #f1, "-- Written by James Bushell" print #f1, "-- Automatically generated (insert date here!)" While eSheets.hasMoreElements oSheet = eSheets.nextElement() If left(oSheet.getName,1) <> "_" Then
orderNumber = oSheet.getCellByPosition(2,0).getString
if orderNumber="" Then orderNumber = lastNumber
lastNumber = val(orderNumber) + 1
print #f1, "DELETE FROM " & oSheet.getName & ";"
End If
Wend
close #f1
StatusText "File now available at " & currentPath
Msgbox "File now available at " & currentPath
End function
'Generates ALL SQL for parametermanager
function BuildAPMSQL()
StatusText "Generating Table/Column definitions for APM"
'iterate over all sheets
Dim oSheet As Object
Dim eSheets As Object
Dim oRow as Object
Dim oColumn as Object
eSheets = ThisComponent.getSheets.createEnumeration
Dim textFile as Object
f1 = FreeFile()
currentPath=makeCurrentPath() & "apmsql.sql"
Open currentPath for output as #f1
print #f1, "-- Application Parameter Manager (APM)"
print #f1, "-- Loader File for MAPS WOW"
print #f1, "-- Written by James Bushell"
print #f1, "-- Automatically generated (insert date here!)"
print #f1,""
print #f1,""
print #f1,"TRUNCATE TABLE table_data;"
print #f1,"TRUNCATE TABLE table_columns;"
print #f1,"TRUNCATE TABLE table_list;"
print #f1,""
x = 0
SystemID = 1 ' This is WOWMAPS as from system_names
'Skip the _CTL sheet
While eSheets.hasMoreElements
oSheet = eSheets.nextElement()
'Only non control sheets please :)
columnNameList=""
if left(oSheet.getName,1) <> "_" Then
statusText "Generating table " & oSheet.getName
x = x + 10
tmp = "INSERT INTO table_list (table_id,system_id, table_name, table_order) VALUES(" & x & "," & SystemID & "," & getCharField(oSheet.getName) & ","
cellVal = oSheet.getCellByPosition(2, 0).String
if (cellVal > "") Then
tmp = tmp & cellVal
Else
tmp = tmp & x 'This is the table order. TODO MAKE IT BETTER!!
End If
tmp = tmp & ");"
print #f1, tmp
hdr="INSERT INTO table_columns (table_id,field_type_id,column_name,column_order) VALUES("
ftr = ");"
for a = 0 to 50
oCell= oSheet.getCellByPosition(a, 2)
txt = oCell.String
if len(txt) > 0 Then
if a > 0 Then columnNameList = columnNameList & ","
columnNameList = columnNameList & txt
tmp=hdr
tmp = tmp & x & "," 'table_id generated
'Now get the control char for type of field
'C=char=1 in apm db
'I=Integer=2 in apm db
oCell = oSheet.getCellByPosition(a, 1)
fieldType = oCell.String
if (fieldType="I") Then
tmp = tmp & "2"
Else
tmp = tmp & "1"
End If
tmp = tmp & "," & getCharField(txt) & ","
tmp = tmp & (a+1)
tmp = tmp & ftr
print #f1, tmp
Else
Exit For
End If
next
'Do the data here
End If
Wend
close #f1
StatusText "Completed..."
msgbox "File is created and is at " & currentPath
end function
rem THis is hardly ever run
private function insertControlRow()
'RUn once code
'iterate over all sheets
Dim oSheet As Object
Dim eSheets As Object
Dim oRow as Object
Dim oColumn as Object
Dim oCell as Object
eSheets = ThisComponent.getSheets.createEnumeration
'Skip the _CTL sheet
x=10
While eSheets.hasMoreElements
oSheet = eSheets.nextElement()
'Only non control sheets please :)
columnNameList=""
if left(oSheet.getName,1) <> "_" Then
'Automatically generate the control lines
if left(oSheet.getCellByPosition(0,0).String,14) <> "LEAVE THIS ROW" Then
oSheet.getRows().insertByIndex(0,2)
End If
oCell = oSheet.getCellByPosition(0,0)
oCell.String = "LEAVE THIS ROW AND THE NEXT ONE ALONE!!!"
oCell = oSheet.getCellByPosition(1,0)
oCell.String = "ORDER"
oCell.CellBackColor = 10040064
oCell = oSheet.getCellByPosition(2,0)
oCell.String = x
oCell.CellBackColor = 10040064
x = x + 10
'Now set all the fields to CHAR
for a = 0 to 50
oCell= oSheet.getCellByPosition(a, 2)
txt = oCell.String
if len(txt) > 0 Then
if oSheet.getCellByPosition(a,1).String="" Then
oSheet.getCellByPosition(a,1).String="C"
end if
Else
Exit For
End If
next
end if
Wend
end function
Rem Builds all of the data into SQL file
Rem ORDER in each sheet (on row 1 col c) is important as is row 2 for C (char) and I (int)
function buildAllDataSQL()
StatusText "Generating data INSERT sql"
'iterate over all sheets
Dim oSheet As Object
Dim eSheets As Object
Dim oRow as Object
Dim oColumn as Object
eSheets = ThisComponent.getSheets.createEnumeration
Dim fileSheets(255)
Dim textFile as Object
f1 = FreeFile()
f2 = FreeFile()
currentPath=makeCurrentPath()
Open currentPath & "mainsql.sql" for output as #f1
print #f1, "-- Application Parameter Manager (APM)"
print #f1, "-- DATA Generation File for MAPS WOW"
print #f1, "-- Written by James Bushell"
print #f1, "-- Automatically generated (insert date here!)"
x = 0
SystemID = 1 ' This is WOWMAPS as from system_names
'Skip the _CTL sheet
While eSheets.hasMoreElements
oSheet = eSheets.nextElement()
'Only non control sheets please :)
columnNameList=""
bRow = true
iRow = 3
lastNumber = 10
if left(oSheet.getName,1) <> "_" Then
StatusText "Working through table [" & oSheet.getName & "]"
orderNumber = oSheet.getCellByPosition(2,0).getString
if orderNumber="" Then orderNumber = lastNumber
lastNumber = val(orderNumber) + 1
fileName = currentPath & format(orderNumber,"00000") & "_" & oSheet.getName & ".sql"
Open fileName for output as #2
fileSheets(x) = fileName
'Build all Column Names
columnNameList = "INSERT INTO " & oSheet.getName & "("
for a = 0 to 50
'Get column name
txt = oSheet.getCellByPosition(a, 2).String
if len(txt) > 0 Then
if a > 0 Then
columnNameList = columnNameList & ","
End If
columnNameList = columnNameList & txt
Else
Exit For
End If
Next
columnNameList = columnNameList & ") VALUES("
while bRow = true
oRow = oSheet.getRows().getByIndex(iRow)
if (oRow.getCellByPosition(0,0).String = "") Then
bRow = false
Else
StatusText "Table [" + oSheet.getName + "] Parsing Row " & iRow
rowData = ""
for a = 0 to 50
oCell= oRow.getCellByPosition(a, 0)
txt = oCell.String
if len(txt) > 0 Then
if a > 0 Then
rowData = rowData & ","
End If
'Now get the control char for type of field
'C=char=1 in apm db
'I=Integer=2 in apm db
oCell = oSheet.getCellByPosition(a, 1)
fieldType = oCell.String
if (fieldType="I") Then
rowData = rowData & GetIntField(txt)
Else
rowData = rowData & GetCharField(txt)
End If
Else
Exit For
End If
next
print #2, columnNameList & rowData & ");"
End If
iRow = iRow + 1
Wend
close #2
'Do the data here
x = x + 1
End If
Wend
StatusText "Sorting generated files"
ShellSort(fileSheets)
for a = lbound(fileSheets) to ubound(filesheets)
if (fileSheets(a) > "") Then
print #f1 ""
Open fileSheets(a) For Input As #2
StatusText "Merging " & fileSheets(a)
Do While NOT EOF(2)
Line Input #2, entry
print #f1, entry
Loop
Close #2
End If
next
close #f1
StatusText "Completed..."
msgbox "File is created and is at " & currentPath & "mainsql.sql"
end function
Private Sub ShellSort(myList())
Dim k1 As Long, k2 As Long, listSize As Long
Dim x1 As Long, isSorted As Boolean
Dim swapping
listSize = UBound(myList()) +1 -LBound(myList())
k1 = Fix(listSize /2)
do while k1 > 0
k2 = UBound(myList()) - k1
isSorted = true
for x1 = LBound(myList()) to k2
if StrComp(myList(x1), myList(x1 +k1), 0) = 1 then
swapping = myList(x1)
myList(x1) = myList(x1 +k1)
myList(x1 +k1) = swapping
isSorted = false
end if
next
if isSorted then
k1 = Fix(k1 /2)
end if
loop
End Sub
Private Function _makeInsertSQLForSheet(oSheet)
'Only non control sheets please :)
columnNameList=""
bRow = true
iRow = 3
numCols = 0
if left(oSheet.getName,1) <> "_" Then
orderNumber = oSheet.getCellByPosition(2,0).getString
if orderNumber="" Then orderNumber = 1
fileName = makeCurrentPath() & format(orderNumber,"00000") & "_" & oSheet.getName & ".sql"
Open fileName for output as #2
'Build all Column Names
columnNameList = "INSERT INTO " & oSheet.getName & "("
for a = 0 to 50
'Get column name
txt = oSheet.getCellByPosition(a, 2).String
if len(txt) > 0 Then
if a > 0 Then
columnNameList = columnNameList & ","
End If
columnNameList = columnNameList & txt
Else
Exit For
End If
Next
numCols = (a-1)
columnNameList = columnNameList & ") VALUES("
while bRow = true
StatusText "Parsing Row " & iRow
oRow = oSheet.getRows().getByIndex(iRow)
if (oRow.getCellByPosition(0,0).String = "") Then
bRow = false
Else
rowData = ""
for a = 0 to numCols
oCell= oRow.getCellByPosition(a, 0)
txt = oCell.String
if len(txt) > 0 Then
if a > 0 Then
rowData = rowData & ","
End If
'Now get the control char for type of field
'C=char=1 in apm db
'I=Integer=2 in apm db
oCell = oSheet.getCellByPosition(a, 1)
fieldType = oCell.String
if (fieldType="I") Then
rowData = rowData & GetIntField(txt)
Else
rowData = rowData & GetCharField(txt)
End If
Else
Exit For
End If
next
print #2, columnNameList & rowData & ");"
End If
iRow = iRow + 1
Wend
close #2
status = "File now available at " & fileName
StatusText status
msgbox status
End If
End Function
Private Function _makeInsertSQLForRow(oSheet, oRow)
'Only non control sheets please :)
columnNameList=""
bRow = true
iRow = 3
numCols = 0
if left(oSheet.getName,1) <> "_" Then
if (oRow.getCellByPosition(0,0).String = "") Then
msgbox "Cannot build this row as theres no data on it!!"
Else
'Build all Column Names
columnNameList = "INSERT INTO " & oSheet.getName & "("
for a = 0 to 50
'Get column name
txt = oSheet.getCellByPosition(a, 2).String
if len(txt) > 0 Then
if a > 0 Then
columnNameList = columnNameList & ","
End If
columnNameList = columnNameList & txt
Else
Exit For
End If
Next
numCols = (a-1)
columnNameList = columnNameList & ") VALUES("
rowData = ""
for a = 0 to numCols
oCell= oRow.getCellByPosition(a, 0)
txt = oCell.String
if len(txt) > 0 Then
if a > 0 Then
rowData = rowData & ","
End If
'Now get the control char for type of field
'C=char=1 in apm db
'I=Integer=2 in apm db
oCell = oSheet.getCellByPosition(a, 1)
fieldType = oCell.String
if (fieldType="I") Then
rowData = rowData & GetIntField(txt)
Else
rowData = rowData & GetCharField(txt)
End If
Else
Exit For
End If
next
_makeInsertSQLForRow = columnNameList & rowData & ");"
StatusText "Row built and available on clipboard"
End If
Else
msgbox "Cannot build row against control sheet!"
End If
End Function
private Function ProgressBar
ProgressBar = ThisComponent.CurrentController.StatusIndicator
End Function
REM display text in status bar
Sub StatusText(sInformation as String)
Dim iLen As Integer
Dim iRest as Integer
iLen = Len(sInformation)
iRest = 270-iLen
ProgressBar.start(sInformation+SPACE(iRest),0)
End Sub
public Function generateInsertsForCurrentSheet()
StatusText "Please wait - generating INSERT file"
_makeInsertSQLForSheet getCurrentSheet()
End Function
public Function generateInsertForCurrentRow()
startRow = ThisComponent.getCurrentController().getSelection().getRangeAddress().startRow
endRow = ThisComponent.getCurrentController().getSelection().getRangeAddress().endRow
Dim fullText, txt
for a = startRow to endRow
StatusText "Please wait - Building row " & a
row = getCurrentSheet().getRows.getByIndex(a)
txt = _makeInsertSQLForRow(getCurrentSheet(), row)
fullText = fullText & txt & chr(10)
next
x = (endRow - startRow) + 1
msgbox x & " row(s) generated and now available on clipboard"
TextToClipboard fullText
End Function
Sub TextToClipboard(cText)
clipText = cText
oClip = createUnoService ("com.sun.star.datatransfer.clipboard.SystemClipboard")
oTRX = createUnoListener("TR_", "com.sun.star.datatransfer.XTransferable")
oClipContents = oClip.setContents(oTRX, null)
End Sub
private Function TR_getTransferData( aFlavor As com.sun.star.datatransfer.DataFlavor ) As Any
If (aFlavor.MimeType = "text/plain;charset=utf-16") Then
TR_getTransferData = clipText
End If
End Function
private Function TR_getTransferDataFlavors() As Any
Dim aF As New com.sun.star.datatransfer.DataFlavor
aF.MimeType = "text/plain;charset=utf-16"
aF.HumanPresentableName = "Unicode-Text"
TR_getTransferDataFlavors = Array(aF)
End Function
private Function TR_isDataFlavorSupported( aFlavor As com.sun.star.datatransfer.DataFlavor ) As Boolean
TR_isDataFlavorSupported = (aFlavor.MimeType = "text/plain;charset=utf-16")
End Function
No comments:
Post a Comment