11/22/2024 3:55:08 AM
|
| |
| slxdeveloper.com Community Forums |
|
| |
|
|
The Forums on slxdeveloper.com are now retired. The forum archive will remain available for the time being. Thank you for your participation on slxdeveloper.com!
Forum to discuss general SalesLogix import and data migration topics. View the code of conduct for posting guidelines.
|
|
|
| |
|
Re: exporting activities to Excel
Posted: 13 Feb 09 4:00 PM
|
1. Well you can dump it to EXCEL in SQL Query Analyzer.....
or
2. Build up a record Set of the user's activities....
and then
3. Call this script (not available in 6.10, it comes into SLX about 6.20....but we use it all of the time in 6.100000)
'Including Script - System:SLX Error Support
'*********************************************************************************************************
' Description: Export Grid or RS To Excel
' Purpose : Export data from a grid or recordset into an excel spreedsheet
' If grid object data will be displayed in excel exactly as what appears in the grid, any
' columns that are hidden will remain hidden
' If RS object data will be desplayed in excel exactly as what appears in RS, using a RS,
' however, allows the ability to customize the data prior to calling ExportRSToExcel
' Inputs : Grid object or Recordset object
' Written : 06/24/03
' Updates : November 2007, July 2008 RJ Samp Adjusted the Grid Output.
' August 2008 RJ Samp used RegExp output to eliminate nonprintable characters. Implemented a methodology to handle LARGE rowcounts.
' October 2008 RJS tested Excel RStoGrid from Stephen Redmond. Works fine. Added 'caption' hints.
' December 2008 added more hints for display captions.
'*********************************************************************************************************
option explicit
Dim objExcel 'Excel object
Dim blnCurrencySymbol 'Whether or not we display the currency symbol for appropriate data types
'''' TxDataGridColumnType
CONST ctStandard = 0
CONST ctMask = 1
CONST ctButton = 2
CONST ctDate = 3
CONST ctCheck = 4
CONST ctImage = 5
CONST ctSpin = 6
CONST ctCombo = 8
CONST ctCalculator = 9
CONST ctPictureBlob = 10
CONST ctHyperlink = 11
CONST ctTime = 12
CONST crCurrency = 13
CONST ctMemo = 14
CONST ctPickList = 15
''' TxAlignment
CONST taLeftJustify = 0
CONST taRightJustify = 1
CONST taCenter = 2
''' TxTextAlignment
CONST tlTop = 0
CONST tlCenter = 1
CONST tlBottom = 2
'''' FormatType
CONST ftNone = 0
CONST ftFixed = 1
CONST ftInteger = 2
CONST ftDateTime = 3
CONST ftPerCent = 4
CONST ftCurrency = 5
CONST ftUser = 6
CONST ftPhone = 7
CONST ftOwner = 8
CONST ftBoolean = 9
CONST ftPosInteger = 10
'' RJ Samp July 2008
CONST BigReportSize = 25
CONST MaxExcelRows = 65000
DIm TimeStart
DIM TimeEnd
DIm TimeUsed
DIM ExportRows
DIM nCols
DIM nRows
DIM MTEXT, RowText
Dim intRow, intCol, intRecordCount
Dim aRows, aColCaptions, aColFormatType, aColDataType(100)
Dim xRS
dim strName
DIM J, strALIAS
'' RJ Samp August 2008
DIM oRegEXP, sTEMP
CONST OKforExcellCell = "[\x00-\x1F\x7E-\x7F]{1,}"
CONST RunCleaner = TRUE
Sub Main
'Initialize
blnCurrencySymbol = True
End Sub
Sub ExportGridToExcel(ByRef objGrid, ByVal SheetName)
''' This is my tricky way to call the new function via the old SLX Call.
ExportToExcel "Grid" , objGrid, SheetName
End Sub
Sub ExportRSToExcel(ByRef xRS, ByVal SheetName)
''' This is my tricky way to call the new function via the old SLX Call.
ExportToExcel "RS" , xRS, SheetName
END SUB
SUB ExportToExcel(ByVal SourceOption, ByRef SourceObject, ByVal SheetName)
''' RJS 2008: basically completely rewritten. Too many changes to note individually
''' started with OOTB SLX call, it follows the same flow. The twist/change is in how to handle large row counts.
On Error Resume Next
IF SourceOption = "Grid" THEN
'Get the RS from the Grid
Set xRS = SourceObject.Recordset
ELSE
SET xRS = SourceObject
END IF
'Make sure there are records
If xRS.RecordCount < 1 Then Exit Sub
'Move to the first record
xRS.MoveFirst
IF SourceOption = "Grid" THEN
'Get an array of visible FieldNames in the grid, then get only those fields from the RS
aRows = xRS.GetRows(,, GetArrayVisibleColumnNames(SourceObject))
ELSE
'Read all of the records into an array
aRows = xRS.GetRows()
END IF
'Get the number of records
intRecordCount = UBound(aRows, 2) + 1
ExportRows = intRecordCount
'Create reference variable for the spreadsheet. If Excel isn't found exit sub
If Not CreateExcelObject Then Exit Sub
if intRecordCount > BigReportSize THEN MSGBOX " Creating spreadsheet for " & intRecordCount & " rows."
TIMESTART = Timer
objExcel.Visible = FALSE
objExcel.Workbooks.Add
'Ensure that Excel remains visible if we switch to the Active Sheet
SetExcelActiveSheet(objExcel)
'Set the SpreedSheet name, if specified
If SheetName <> "" Then
'Sheet name can be no more than 31 characters
objExcel.Sheets(1).Name = LEFT(TRIM("" & SheetName),31)
End If
'''''
IF SourceOption = "Grid" THEN
'Get array of visible captions in the grid as will be displayed in Excel
aColCaptions = GetArrayVisibleColumnCaptions(SourceObject)
aColFormatType = GetArrayVisibleColumnFormatType(SourceObject)
END IF
'Format the Column header
intRow = 1
intCol = 1
nCols = UBound(aRows, 1) + 1
''' MSGBOX nCOLS
For intCol = 1 To nCols
objExcel.Columns(intCol).VerticalAlignment = -4160 'Align Top
'''' RJ Samp
IF SourceOption = "Grid" THEN
objExcel.Columns(intCol).NumberFormat = GetFormatType(aColFormatType(intCol))
With objExcel.Cells(intRow, intCol)
.Value = aColCaptions(intCol - 1)
' MSGBOX .VALUE
aColDataType(intCol) = "Text"
IF instr(1,.VALUE, "Grade",1) > 0 THEN
objExcel.Columns(intCol).NumberFormat = "@"
aColDataType(intCol) = "Text"
END IF
IF .Value = "PID" or .VALUE = "Postalcode" or .VALUE = "Postal code" THEN
objExcel.Columns(intCol).NumberFormat = "@"
aColDataType(intCol) = "Text"
END IF
IF instr(1,.VALUE, "Potential",1) > 0 THEN
objExcel.Columns(intCol).NumberFormat = "$##,###.00;[Red]($##,###.00)"
aColDataType(intCol) = "Number"
END IF
IF instr(1,.VALUE, "Discount",1) > 0 THEN
objExcel.Columns(intCol).NumberFormat = "##,##0.00% "
aColDataType(intCol) = "Number"
END IF
IF instr(1,.VALUE, "%",1) > 0 THEN
''' objExcel.Columns(intCol).NumberFormat = "##,##0.00% "
aColDataType(intCol) = "Number"
END IF
IF instr(1,.VALUE, "Enroll",1) > 0 THEN
objExcel.Columns(intCol).NumberFormat = "##,##0 "
aColDataType(intCol) = "Number"
END IF
IF instr(1,.VALUE, "Student",1) > 0 THEN
objExcel.Columns(intCol).NumberFormat = "##,##0 "
aColDataType(intCol) = "Number"
END IF
IF instr(1,.VALUE, "School",1) > 0 THEN
objExcel.Columns(intCol).NumberFormat = "##,##0 "
aColDataType(intCol) = "Number"
END IF
IF instr(1,.VALUE, "Price",1) > 0 THEN
objExcel.Columns(intCol).NumberFormat = "$##,###.00;[Red]($##,###.00)"
aColDataType(intCol) = "Number"
END IF
IF instr(1,.VALUE, "$",1) > 0 THEN
objExcel.Columns(intCol).NumberFormat = "$##,###.00;[Red]($##,###.00)"
aColDataType(intCol) = "Number"
END IF
IF instr(1,.VALUE, "Amount",1) > 0 THEN
objExcel.Columns(intCol).NumberFormat = "$##,###.00;[Red]($##,###.00)"
aColDataType(intCol) = "Number"
END IF
IF instr(1,.VALUE, "ActualClose",1) > 0 OR instr(1,.VALUE, "Actual Close",1) > 0 THEN
objExcel.Columns(intCol).NumberFormat = "mm/dd/yyyy"
aColDataType(intCol) = "Date"
END IF
IF instr(1,.VALUE, "Est",1) > 0 OR instr(1,.VALUE, "Close",1) > 0 THEN
objExcel.Columns(intCol).NumberFormat = "mm/dd/yyyy"
aColDataType(intCol) = "Date"
END IF
IF instr(1,.VALUE, "Date",1) > 0 THEN
objExcel.Columns(intCol).NumberFormat = "mm/dd/yyyy"
aColDataType(intCol) = "Date"
END IF
IF instr(1,.VALUE, "Start",1) > 0 THEN
objExcel.Columns(intCol).NumberFormat = "mm/dd/yyyy"
aColDataType(intCol) = "Date"
END IF
IF instr(1,.VALUE, "End",1) > 0 THEN
objExcel.Columns(intCol).NumberFormat = "mm/dd/yyyy"
aColDataType(intCol) = "Date"
END IF
With .Font
.Name = "Arial" 'DNL
.Bold = True
.Size = 9
End With
End With
ELSE
'Place the names of the fields in the column headers
'''' RJ Samp
objExcel.Columns(intCol).NumberFormat = GetDBFormatType(xRS.Fields.Item(intCol - 1).Type)
With objExcel.Cells(1, intCol)
strName = Application.Translator.Localize(xRS.Fields(intCol - 1).Name)
' application.Debug.WriteLine " Export Column [" & intCOL & "] "& strNAME & " "
''RJize the Captions. we could use the SLX Display name if we knew the TableName....
strName = CleanUpFieldName(strNAME)
.Value = strNAME
With .Font
.Name = "Arial" 'DNL
.Bold = True
.Size = 9
End With
End With
END IF
' MSGBOX "Column: " & intCOL
Next
IF EXPORTROWS > MaxExcelROWS - 2 THEN EXPORTROWS = MaxExcelROWS - 2
SET oRegEXP = CreateObject("VBScript.RegExp")
WITH oRegEXP
.Global = True
.IgnoreCase = True
.Pattern = OKforExcellCell
END WITH
'Build up a massive string of Data + TAB + DATA + TAB + EOL for all data rows.
MText = ""
For intRow = 2 To EXPORTROWS + 1
RowText = ""
For intCol = 1 To UBound(aRows, 1) + 1
sTEMP = aRows(intCol - 1, intRow - 2)
If aColDataType(IntCol) = "Text" THEN
IF RunCleaner THEN
IF oregexp.TEXT(sTEMP) THEN sTEMP = oregexp.Replace(sTEMP, "") '''''clear out bad EXCEL characters.
END IF
END IF
RowText = RowText & sTEMP & CHR(9)
NEXT
MText = MText & RowText & CHR(13)
NEXT
''''put the string into the windows clipboard.
DIM oSHELL, objHTM
set oShell = CreateObject("WScript.Shell")
Set objHTM = CreateObject("htmlfile")
objHTM.ParentWindow.ClipboardData.SetData "text", MText
'paste it into Excel.
objExcel.Range("A2").SELECT
objExcel.ActiveSheet.Paste
SET oRegEXP = NOTHING
objExcel.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
objExcel.Visible = True
TIMEEND = Timer
Erase aColCaptions
Erase aColFormatType
Erase aColDataType
Set objExcel = Nothing
TimeUsed = (TimeEnd - TimeStart)
application.Debug.WriteLine "Grid exported to Excel, " & EXPORTROWS & " formatted rows, in: " & TIMEUSED & " seconds. "
On Error Goto 0
END SUB
'Create reference variable for the spreadsheet if Excel is found, if not display message.
Function CreateExcelObject
Dim blnExcel
blnExcel = True
On Error Resume Next
'Create reference variable for the spreadsheet
Set objExcel = CreateObject("Excel.Application") 'DNL
If Not IsObject(objExcel) Then
MsgBox Application.Translator.Localize("Microsoft Excel cannot be found. ") & vbCrLf & vbCrLf & _
Application.Translator.Localize("Please insure Excel is installed prior to using this feature."), vbExclamation, "SalesLogix"
blnExcel = False
End If
CreateExcelObject = blnExcel
End Function
Sub SetExcelActiveSheet(objExcel)
Dim objTemp
Set objTemp = objExcel
If objExcel.Application.Version >= 8 Then
Set objExcel = objExcel.ActiveSheet
End If
Set objTemp = Nothing
End Sub
Function GetArrayVisibleColumnNames(BYREF objGrid)
Dim aColumns()
Dim i, intColumn
intColumn = 0
'Get the number of visible columns on the grid
ReDim aColumns(GetVisibleColumnsCount(objGrid))
For i = 0 To objGrid.Columns.Count - 1
'For each visible column add to array
If objGrid.Columns.Item(i).Visible Then
aColumns(intColumn) = objGrid.Columns.Item(i).FieldName
intColumn = intColumn + 1
End If
Next
GetArrayVisibleColumnNames = aColumns
Erase aColumns
End Function
Function GetArrayVisibleColumnCaptions(BYREF objGrid)
Dim aColumns()
Dim intColumn
Dim i
intColumn = 0
'Get the number of visible columns on the grid
ReDim aColumns(GetVisibleColumnsCount(objGrid))
For i = 0 To objGrid.Columns.Count - 1
'For each visible column add to array
If objGrid.Columns.Item(i).Visible Then
aColumns(intColumn) = objGrid.Columns.Item(i).Caption
'''' MSGBOX "Field Name" & objGrid.Columns.Item(i).FieldName '''' this is the FieldName used in the Data Grid (includes Alias Name).
intColumn = intColumn + 1
End If
Next
GetArrayVisibleColumnCaptions = aColumns
Erase aColumns
End Function
Function GetArrayVisibleColumnFormatType(BYREF objGrid)
Dim aColumnsFormatType()
Dim intColumn
Dim i
intColumn = 0
'Get the number of visible columns on the grid
ReDim aColumnsFormatType(GetVisibleColumnsCount(objGrid))
For i = 0 To objGrid.Columns.Count - 1
'For each visible column add to array
If objGrid.Columns.Item(i).Visible Then
aColumnsFormatType(intColumn) = objGrid.Columns.Item(i).FORMATTYPE
application.debug.WriteLine "Field Name " & objGrid.Columns.Item(i).FieldName & " FormatType " & aColumnsFormatType(intColumn) '''' this is the FieldName used in the Data Grid (includes Alias Name).
intColumn = intColumn + 1
End If
Next
GetArrayVisibleColumnFormatType = aColumns
Erase aColumns
End Function
Function GetVisibleColumnsCount(BYREF objGrid)
Dim i, intCount
'Loop through the Columns collection of the grid to get count of visible columns
intCount = 0
For i = 0 To objGrid.Columns.Count - 1
If objGrid.Columns.Item(i).Visible Then
intCount = intCount + 1
End If
Next
GetVisibleColumnsCount = intCount - 1
End Function
Function GetFormatType(strFormatType)
'' CONST ftNone = 0
'' CONST ftFixed = 1
'' CONST ftInteger = 2
'' CONST ftDateTime = 3
'' CONST ftPerCent = 4
'' CONST ftCurrency = 5
'' CONST ftUser = 6
'' CONST ftPhone = 7
'' CONST ftOwner = 8
'' CONST ftBoolean = 9
'' CONST ftPosInteger = 10
GetFormatType = "General"
Select Case strFormatType
CASE 0
GetFormatType = "@"
CASE 1
GetFormatType = "#,##0.0000"
Case 2 'Integer
GetFormatType = "#,##0" 'DNL
CASE 3
'' GetFormatType = "[$-409]mm/dd/yyyy h:mm AM/PM;@"
GetFormatType = "mm/dd/yyyy"
Case 4
GetFormatType = "#,##0" '''"0.00%"
Case 5 'Currency'
GetFormatType = FormatCurrencyString
Case 6
GetFormatType = "@"
Case 7
GetFormatType = "[<=9999999]###-####;(###) ###-####"
Case 8
GetFormatType = "@"
Case 9
GetFormatType = "@"
Case 10 ' Pos Integer
GetFormatType = "#,##0" 'DNL
Case Else
GetFormatType = "@"
End select
End Function
Function GetDBFormatType(strFormatType)
Select Case strFormatType
Case 3 'adInteger
GetDBFormatType = "#,##0" 'DNL
Case 4 'adSingle
GetDBFormatType = FormatCurrencyString
Case 5 'adDouble
GetDBFormatType = FormatCurrencyString
Case 6 'adCurrency'
GetDBFormatType = FormatCurrencyString
Case 11 'adBoolean
GetDBFormatType = "#,##0" 'DNL
Case 131 'adNumeric
GetDBFormatType = "#,##0" 'DNL
Case Else
GetDBFormatType = ""
End select
End Function
Function FormatCurrencyString
If Not blnCurrencySymbol Then
FormatCurrencyString = "#,##0.00" 'DNL
Else
Select Case Application.Translator.CurrencyFormat
Case 0
FormatCurrencyString = Application.Translator.CurrencyString & "#,##0.00" 'DNL
Case 3
FormatCurrencyString = "#,##0.00 " + Application.Translator.CurrencyString 'DNL
Case Else
FormatCurrencyString = Application.Translator.CurrencyString + " #,##0.00" 'DNL
End Select
End If
End Function
'Looks for duplicate records based on specified Fields, if found enters an empty string as the new value
'Paramaters: xRS - Recordset object
' aFieldNames - Array of Fields to be searched
Function RemoveDuplicateValue(xRS, aFieldNames)
Dim strValue, Field
Dim i
With xRS
.MoveFirst
For Each Field In aFieldNames
For i = 0 To .RecordCount - 1
If .Fields.Item(Field).Value = strValue Then
.Fields.Item(Field).Value = ""
End If
strValue = .Fields.Item(Field).OriginalValue
.MoveNext
Next
.MoveFirst
Next
End With
End Function
'Loops through RS for the specified value, if found replaces old value with the specified new value
'Paramaters: xRS - Recordset object
' aFieldNames - Array of Fields to be searched
' strValue - Value to be searched and replaced if found
' strNewValue - New value of strValue if found
Function RecordsetReplaceValues(xRS, aFieldNames, strValue, strNewValue)
Dim Field
Dim i
With xRS
.MoveFirst
For i = 0 To .RecordCount - 1
For Each Field In aFieldNames
If Not IsNull(.Fields.Item(Field).Value) Then
.Fields.Item(Field).Value = Replace(.Fields.Item(Field).Value, strValue, strNewValue)
End If
Next
.MoveNext
Next
End With
Set RecordsetReplaceValues = xRS
End Function
Sub DisplayCurrencySymbol(blnValue)
blnCurrencySymbol = blnValue
End Sub
'''' Stephen Redmonds! THANK YOU!
'''' RJ Samp December 2008 adapted for use at Discovery Education.
Sub ExportExcel(ByRef dg1, byval WorkSheetName)
'''' Parameter 1: dg1 is an SLX ActiveX Control DataGrid. The data to be exported is in its recordset.
'''' Parameter 2: WorkSheetName is what we will call the Excel Worksheet (which sits in an Excel Spreadsheet).
'''' used EXCEL method ExportRStoExcel.
On Error Resume Next
Dim xl
Set xl = CreateObject("Excel.Application")
If Not IsObject(xl) Then
MsgBox "Microsoft Excel error. Is it installed?", 48, "Excel Error"
Exit Sub
End If
Dim wb
Set wb = xl.WorkBooks.Add
xl.Application.Visible = FALSE ''' RJ Samp '''' True
While wb.Sheets.Count > 1
wb.Sheets(1).Delete
Wend
Dim ws
Set ws = wb.Sheets(1)
ws.Name = WorkSheetName '''' RJ Samp October 2008.
Dim fld
Dim iCol, maxCol
Dim iRow
Dim rs
DIM strNAME
Set rs = dg1.Recordset
rs.MoveFirst
iCol = 1
iRow = 1
Dim FirstField, SecondField, isIDField
Dim LastNumeric
FirstField = ""
SecondField = ""
LastNumeric = ""
isIDField = False
'' RJ Samp
DIM ADATA()
ADATA = GetArrayVisibleColumnFormatType(dg1) ''''RJS 10/2008 gets an array of the visible columns Grid Format type.
''------------------------------
for each fld in rs.Fields
''' RJ Samp Oceober 2008
strNAME = fld.Name
strNAME = CleanUpFieldName(strName)
''-----------------------------
ws.Cells(iRow, iCol).Value = strNAME
ws.Cells(iRow, iCol).Font.Bold = true
if Right(Trim(UCase(fld.Name)), 2) = "ID" Then
isIDField = True
Else
isIDField = False
End if
if fld.Type = adChar or fld.Type = adVarChar or fld.Type = adLongVarChar Then
if FirstField = "" and not isIDField then
FirstField = fld.Name
Elseif SecondField = "" and not isIDField then
SecondField = fld.Name
End if
Elseif fld.Type = adInteger Then
if fld.Name <> "" then LastNumeric = fld.Name
Elseif fld.Type = adDouble or fld.Type = adNumeric Then
if fld.Name <> "" then LastNumeric = fld.Name
Else
if FirstField = "" and not isIDField then
FirstField = fld.Name
Elseif SecondField = "" and isIDField then
SecondField = fld.Name
End if
End if
iCol = iCol + 1
Next
maxCol = iCol-1
iRow = 2
iCol = 1
Dim c0, c1, c2
Set c0 = ws.Cells(1,1)
Set c1 = ws.Cells(2,1)
Set c2 = ws.Cells(rs.RecordCount+1, rs.Fields.Count)
xl.Range(c1, c2).CopyFromRecordset rs
Set c1 = ws.Cells(1,1)
xl.Range(c1, c2).EntireColumn.Autofit
xl.Range(c1, c2).Select
xl.Range(c0, c2).Name = "QueryExport"
for each fld in rs.Fields
if Right(Trim(UCase(fld.Name)), 2) = "ID" Then
'''' 2008 RJ Samp: let's not hide them. ws.Columns(iCol).Hidden = True
End If
'''' RJS: Phone Number? User? Owner?
if fld.Type = adChar or fld.Type = adVarChar or fld.Type = adLongVarChar Then
ws.Columns(iCol).NumberFormat = "@"
elseif fld.Type = adDBTimeStamp Then
ws.Columns(iCol).NumberFormat = "dd/mm/yyyy"
Elseif fld.Type = adInteger Then
ws.Columns(iCol).NumberFormat = "0"
Elseif fld.Type = adDouble or fld.Type = adNumeric Then
ws.Columns(iCol).NumberFormat = "0.00"
Else
ws.Columns(iCol).NumberFormat = "General"
End if
iCol = iCol + 1
Next
xl.Application.Visible = True ''' RJ Samp 2008
End Sub
Function CleanUpFieldName(inName) '''' RJS 2008
DIM J
DIM strALIAS, strNAME
strNAME = inName
FOR J = 2 TO 20 ''' RJ Samp. Take out the SQL Table Alias from the Caption.
strALIAS = "A" & cSTR(J) & "_"
strName = Replace(strName,strALIAS, "")
NEXT
strName = Replace(strName,"_", " ") ''' RJ Samp. Take out the '_'s from the Caption.
strName = REPLACE(strNAME, "DATE", " Date") '''clean up StartDate, ModifyDate, et al
strName = REPLACE(strNAME, "OPENED", " Opened") '''clean up DateOPENED
strName = REPLACE(strNAME, "ACTUALCLOSE", "Actual Close") '''clean up ActualClose
strName = REPLACE(strNAME, "ESTIMATEDCLOSE","Est Close") '''clean up EstimatedClose
strName = REPLACE(strNAME, "AMOUNT", " Amount") '''clean up ActualAmount
strName = REPLACE(strNAME, "PHONE", " Phone")
strName = REPLACE(strNAME, "POTENTIAL", " Potential") '''clean up SalesPotential
strName = REPLACE(strNAME, "PROBABILITY", " Probability") '''clean up ClosePROBABILITY
strName = REPLACE(strNAME, "NAME", " Name") '''clean up UserName, ContactName, AccountName.....
strName = REPLACE(strNAME, "MANAGER", " Manager") '''clean up accountManager.....
strName = REPLACE(strNAME, "POSTALCODE", " Postal Code") '''clean up ZIP code
strName = REPLACE(strNAME, "USER", " User")
strName = Trim(strName)
strName = PROPERCase(strName) ''' RJ Samp Proper Case the Caption
IF RIGHT(strName,2) = "id" THEN
strName = LEFT(strName,LEN(strName) - 2) & " ID" ''' RJize ID fields. Account ID, not Accountid.
END IF
CleanUpFieldName = strName
END FUNCTION
Function ProperCase(ByVal sText) '''' RJS 2008
'*** Converts text to proper case e.g. ***'
'*** surname = Surname ***'
'*** o'connor = O'Connor ***'
Dim a, iLen, bSpace, tmpX, tmpFull
iLen = Len(sText)
For a = 1 To iLen
If a <> 1 Then 'just to make sure 1st character is upper and the rest lower'
If bSpace = True Then
tmpX = UCase(mid(sText,a,1))
bSpace = False
Else
tmpX=LCase(mid(sText,a,1))
If tmpX = " " Or tmpX = "'" Then bSpace = True
End if
Else
tmpX = UCase(mid(sText,a,1))
End if
tmpFull = tmpFull & tmpX
Next
ProperCase = tmpFull
End Function
|
|
|
|
Re: exporting activities to Excel
Posted: 25 Jan 11 2:45 PM
|
fiogf49gjkf0d Evening all
Was wondering if somebody could help me out, am just getting into scripting and im just trying to get my head around this to use, just stuck on the very last bit, could somebody just explain to me what the following bit actually does please?
Any help would be very gratefully received
Thanks
|
|
|
|
Re: exporting activities to Excel
Posted: 25 Jan 11 3:50 PM
|
fiogf49gjkf0d It's a "PrettyCase" function e.g. mike spragg is converted to Mike Spragg or MIKE SPRAGG converts to Mike Spragg. Essentially, makes it nicer looking - falls down on tradenames of course (IBM would go to Ibm) |
|
|
|
Re: exporting activities to Excel
Posted: 25 Jan 11 4:10 PM
|
fiogf49gjkf0d Mike
Thank you very very much, really appreciate the quick response, could i by really cheeky and just run this one past you as well please?
|
|
|
|
Re: exporting activities to Excel
Posted: 25 Jan 11 4:31 PM
|
fiogf49gjkf0d Essentially, it's a text block parser. Imagine:
Field1;DataLine1;Field2;DataLine2;Field3;DataLine3
This function returns the Data item for the required item:
f1 = ParseTextLinePair ("data shown above","Field2") would return "DataLine2" and store it in the var f1.
It's a way of getting specific items from a block of unstructured data - by looking through it, working out if it exists and if so cutting the data apart to the left and right of it - returning just the item value you need. |
|
|
|
Re: exporting activities to Excel
Posted: 25 Jan 11 4:33 PM
|
fiogf49gjkf0d Mike your a legend pal
Thank you so much, your quick reply has possibley just saved my life my friend.
Any time your in Liverpool ill buy you a beer :0) |
|
|
| |
|
You can
subscribe to receive a daily forum digest in your
user profile. View the site code
of conduct for posting guidelines.
 Forum RSS Feed - Subscribe to the forum RSS feed to keep on top of the latest forum activity!
|
|
|
|
|
|
|
|