Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 152
Default Programatically remove VBA Comments & Rename Functions & Routines

Hi,
I have an excel VBA application that I'm considering to sell at some point.

As a deterant to any unauthorized usage, I was wondering if it's possible
through VBA to completely remove all comments and rename all the routines and
functions in all modules and forms with unrecogizable names so that the code
would work yet be vertutally impossible to understand.

Thanks for any help!
MikeZz


  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,344
Default Programatically remove VBA Comments & Rename Functions & Routines

Hi,

Why not just protect the module? In the VBE Tools, VBA Project Properties,
Protection... If you are going to sell an application, make sure it's not
already out their for free. Of course there are Excel programmers who sell
there code even though other programmers offer the same routines for free.

--
Thanks,
Shane Devenshire


"MikeZz" wrote:

Hi,
I have an excel VBA application that I'm considering to sell at some point.

As a deterant to any unauthorized usage, I was wondering if it's possible
through VBA to completely remove all comments and rename all the routines and
functions in all modules and forms with unrecogizable names so that the code
would work yet be vertutally impossible to understand.

Thanks for any help!
MikeZz


  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 152
Default Programatically remove VBA Comments & Rename Functions & Routi

Hi Shane,
I know I can protect the module but it's to easy to bypass it. It's a
rather unique application specific to my industry so I know for sure no one
else has done anything like it.

I think if I do sell it, it will be on a fee basis per month or quarter.
The main purpose of pulling comments out and radomly changing procedure names
is to make it impossible to figure out how it verifies if it's a valid copy.
If I didn't at least do that, someone could easily bypass VBA protection and
figure out how to bypass the security.

I was thinking if I had something to change all the procedure names to
something like: cccccccccc,ccccccccccc,cccccccccccc,ccccccccccccc, a normal
person would never be able to figure out it... each of the above strings
could represent a procedure but since they all look so much alike, it would
be difficult trace and see where the copy protection scheme actually takes
place.

I'm sure someone could figure it out but without any comments and all the
procedures named like the above set, it would certainly keep all but the most
determined out.

I saw a couple other replys that had some ideas so if I choose to pursue
this, it sounds like it's at least doable.

Thanks,
MikeZz

"ShaneDevenshire" wrote:

Hi,

Why not just protect the module? In the VBE Tools, VBA Project Properties,
Protection... If you are going to sell an application, make sure it's not
already out their for free. Of course there are Excel programmers who sell
there code even though other programmers offer the same routines for free.

--
Thanks,
Shane Devenshire


"MikeZz" wrote:

Hi,
I have an excel VBA application that I'm considering to sell at some point.

As a deterant to any unauthorized usage, I was wondering if it's possible
through VBA to completely remove all comments and rename all the routines and
functions in all modules and forms with unrecogizable names so that the code
would work yet be vertutally impossible to understand.

Thanks for any help!
MikeZz


  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 22,906
Default Programatically remove VBA Comments & Rename Functions & Routines

Excerpt from Chip Pearson's site............................

All protection mechanisms in Excel are really intended to prevent the user
from accidentally changing a value or some code. The security just isn't
strong enough to provide real protection of proprietary information or
information or code with intellectual property value. For that level of
security, you should be writing your code in Visual Basic 6 or VB.NET. See
Creating A COM Add-In for details about creating a COM Add-In and Automation
Add Ins A Function Libraries for details about creating an Automation
Add-Ins.

Go to Chip's site for links mentioned in excerpt.

http://www.cpearson.com/excel/workbooktimebomb.aspx


Gord Dibben MS Excel MVP


On Sat, 27 Sep 2008 09:33:01 -0700, MikeZz
wrote:

Hi,
I have an excel VBA application that I'm considering to sell at some point.

As a deterant to any unauthorized usage, I was wondering if it's possible
through VBA to completely remove all comments and rename all the routines and
functions in all modules and forms with unrecogizable names so that the code
would work yet be vertutally impossible to understand.

Thanks for any help!
MikeZz


  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,452
Default Programatically remove VBA Comments & Rename Functions & Routines

This code will remove comments, indentations and blank lines. It will need a
reference to the VBE extensiblity,
Microsoft Visual Basic for Applications Extensibility 5.x. You could put it
in an add-in.

Option Explicit
Private VBProjToClean As VBProject
Private strFileToClean As String

Sub CompactVBEProject()

Dim VBC As VBComponent
Dim WB As Workbook
Dim VBProj As VBProject
Dim strFile As String
Dim msgResult As VbMsgBoxResult

For Each VBProj In Application.VBE.VBProjects
On Error Resume Next
Select Case MsgBox("Compact this file?", _
vbYesNoCancel + vbDefaultButton2, _
VBProj.Filename)
Case vbYes
Set VBProjToClean = VBProj
strFileToClean = VBProj.Filename
Exit For
Case vbNo
Case vbCancel
Exit Sub
End Select
Next

If VBProjToClean Is Nothing Then
Exit Sub
End If

Select Case MsgBox("Do all 3 compacting options?" & _
vbCrLf & vbCrLf & _
"Remove comments" & _
vbCrLf & _
"Remove indentations" & _
vbCrLf & _
"Remove blank lines", _
vbYesNoCancel + vbDefaultButton1, _
strFile)
Case vbYes
VBE_Remove_Comments
VBE_Remove_Indents
VBE_Remove_BlankLines
Case vbNo
Select Case MsgBox("Remove comments from this file?", _
vbYesNoCancel + vbDefaultButton2, strFile)
Case vbYes
VBE_Remove_Comments
Case vbNo
Case vbCancel
Exit Sub
End Select
Select Case MsgBox("Remove indentations from this file?", _
vbYesNoCancel + vbDefaultButton2, strFile)
Case vbYes
VBE_Remove_Indents
Case vbNo
Case vbCancel
Exit Sub
End Select
Select Case MsgBox("Remove blank lines from this file ?", _
vbYesNoCancel + vbDefaultButton2, strFile)
Case vbYes
VBE_Remove_BlankLines
Case vbNo
Case vbCancel
Exit Sub
End Select
Case vbCancel
Exit Sub
End Select

End Sub

Sub VBE_Remove_Comments()

Dim VBC As VBComponent
Dim i As Long
Dim j As Long
Dim str As String
Dim blnStringMode As Boolean
Dim blnLineContinue As Boolean
Dim lCount As Long

With Application
.Cursor = xlWait
.StatusBar = " Removing comments, please wait ..."
End With

For Each VBC In VBProjToClean.VBComponents

blnStringMode = False
i = 1
With VBC.CodeModule

Do Until i .CountOfLines
If Not .ProcOfLine(i, vbext_pk_Proc) = "VBE_Remove_Comments" Then
str = .Lines(i, 1)
blnLineContinue = (Right(str, 2) = " _")

For j = 1 To Len(str)
Select Case Mid(str, j, 1)
Case """": blnStringMode = Not blnStringMode
Case "'"
If Not blnStringMode Then
str = RTrim(Mid(str, 1, j - 1))
If LTrim(str) = "" Then
.DeleteLines i
i = i - 1
lCount = lCount + 1
Else
.ReplaceLine i, str
lCount = lCount + 1
End If

Do While blnLineContinue
blnLineContinue = _
(Right(.Lines(i + 1, 1), 2) = " _")
.DeleteLines i + 1
lCount = lCount + 1
Loop

Exit For
End If
End Select
Next

End If
i = i + 1
Loop
End With
Next

With Application
.Cursor = xlDefault
.StatusBar = False
End With

MsgBox lCount & " comment lines removed", , strFileToClean

End Sub

Sub VBE_Remove_Indents()

Dim VBC As VBComponent
Dim i As Long
Dim j As Long
Dim lCount As Long

With Application
.Cursor = xlWait
.StatusBar = " Removing indentations and trailing spaces, please
wait ..."
End With

For Each VBC In VBProjToClean.VBComponents
With VBC.CodeModule
For i = 1 To .CountOfLines
If Not .ProcOfLine(i, vbext_pk_Proc) = "VBE_Remove_Indents" Then
If Left(.Lines(i, 1), 1) = Chr(32) Then
.ReplaceLine i, _
Replace(.Lines(i, 1), _
.Lines(i, 1), _
Trim$(.Lines(i, 1)), , , _
vbTextCompare)
lCount = lCount + 1
End If
End If
Next
End With
Next

With Application
.Cursor = xlDefault
.StatusBar = False
End With

MsgBox "Removed indentations from " & lCount & " lines", ,
strFileToClean

End Sub

Sub VBE_Remove_BlankLines()

Dim VBC As VBComponent
Dim i As Long
Dim j As Long
Dim lCount As Long

With Application
.Cursor = xlWait
.StatusBar = " Removing blank lines, please wait ..."
End With

For Each VBC In VBProjToClean.VBComponents
With VBC.CodeModule
For i = .CountOfLines To 1 Step -1
If Not .ProcOfLine(i, vbext_pk_Proc) = "VBE_Remove_BlankLines" Then
If Len(Trim(.Lines(i, 1))) = 0 Then
.DeleteLines i
lCount = lCount + 1
End If
End If
Next
End With
Next

With Application
.Cursor = xlDefault
.StatusBar = False
End With

MsgBox "Removed " & lCount & " blank lines", , strFileToClean

End Sub


To scramble all Procedure names shouldn't be too difficult either.
Have a look at this website to learn about manipulating the VBE:
http://www.cpearson.com/excel/vbe.aspx


RBS





"MikeZz" wrote in message
...
Hi,
I have an excel VBA application that I'm considering to sell at some
point.

As a deterant to any unauthorized usage, I was wondering if it's possible
through VBA to completely remove all comments and rename all the routines
and
functions in all modules and forms with unrecogizable names so that the
code
would work yet be vertutally impossible to understand.

Thanks for any help!
MikeZz





  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,452
Default Programatically remove VBA Comments & Rename Functions & Routines

Here a trimmed down version of a VB project documenter I once uploaded to
Planet Source Code.
Once you have all the procedures then it shouldn't be too difficult to
replace with a scrambled name and
do the replacements in the VBE.

Sub test()

Dim VBProj As VBProject
Dim arr

For Each VBProj In Application.VBE.VBProjects
On Error Resume Next
Select Case MsgBox("Document this file?", _
vbYesNoCancel + vbDefaultButton2, _
VBProj.Filename)
Case vbYes
arr = GetProcedures(VBProj)
Exit For
Case vbNo
Case vbCancel
Exit Sub
End Select
Next

If Not IsArray(arr) Then
Exit Sub
End If

Application.ScreenUpdating = False

Cells.Clear
Cells(1) = "Module name"
Cells(2) = "Module type"
Cells(3) = "Procedure name"
Cells(4) = "Procedure type"
Cells(5) = "Procedure start"
Cells(6) = "Procedure lines"

Range(Cells(1), Cells(6)).Font.Bold = True
Range(Cells(2, 1), Cells(UBound(arr) + 1, UBound(arr, 2))) = arr
Range(Cells(1), Cells(UBound(arr) + 1, UBound(arr, 2))).Columns.AutoFit

Application.ScreenUpdating = True

End Sub


Function GetProcedures(VBProj As VBProject) As Variant

Dim i As Long
Dim x As Long
Dim strStatusIndent As String
Dim VBComp As VBComponent
Dim lCodeLine As Long
Dim lProcBodyLine As Long
Dim lProcLineCount As Long
Dim strProcName As String
Dim strProcType As String
Dim strProcNamePrevious As String
Dim lProcType As Long
Dim lProcTypePrevious As Long
Dim lModules As Long
Dim lModuleCount As Long
Dim lModuleLineCount As Long
Dim collModules As Collection
Dim collModulesType As Collection
Dim collProcNames As Collection
Dim collProcTypes As Collection
Dim collProcStartLine As Collection
Dim collProcLineCount As Collection
Dim strWBType As String
Dim arrResult

10 If UCase(Right$(VBProj.Filename, 3)) = "XLA" Then
20 strWBType = "add-in"
30 Else
40 strWBType = "workbook"
50 End If

60 On Error Resume Next
70 lModules = VBProj.VBComponents.Count

80 If Err.Number = 50289 Then
90 MsgBox "Can't document this " & strWBType & _
" as it is protected", , VBProj.Filename
100 Exit Function
110 End If

120 On Error GoTo ERROROUT

130 strStatusIndent = " "

140 Set collModules = New Collection
150 Set collModulesType = New Collection
160 Set collProcNames = New Collection
170 Set collProcTypes = New Collection
180 Set collProcStartLine = New Collection
190 Set collProcLineCount = New Collection

200 For Each VBComp In VBProj.VBComponents

210 Application.StatusBar = strStatusIndent & "doing module " &
VBComp.Name

220 DoEvents
230 lModuleCount = lModuleCount + 1
240 DoEvents

250 With VBComp.CodeModule

'if we don't start past the declarations it will crash as it is now
'------------------------------------------------------------------
260 lCodeLine = .CountOfDeclarationLines

270 Do Until lCodeLine = .CountOfLines

280 lCodeLine = lCodeLine + 1

290 strProcName = .ProcOfLine(lCodeLine, lProcType)

'we have to catch Property procedures that have the same name
'------------------------------------------------------------
300 If strProcName < strProcNamePrevious Or _
lProcType < lProcTypePrevious Then

310 strProcNamePrevious = strProcName
320 lProcTypePrevious = lProcType
330 lProcBodyLine = .ProcBodyLine(strProcName, lProcType)
340 lProcLineCount = .ProcCountLines(strProcName, lProcType)

350 If lProcType = 0 Then
'Sub or Function, unfortunately ProcType can't differentiate
these
'-----------------------------------------------------------------

'find the real end of the procedure
'comments at the end belong to the procedure!
'note that this will fail without the len bit
'--------------------------------------------
360 Do While Len(Trim(.Lines(lProcBodyLine + lProcLineCount - x,
1))) = 0 Or _
(.Find("End Sub", _
lProcBodyLine + lProcLineCount - x, _
1, _
lProcBodyLine + lProcLineCount - x, _
Len(Trim(.Lines(lProcBodyLine + lProcLineCount - x,
1))), _
True, True) = False And _
.Find("End Function", _
lProcBodyLine + lProcLineCount - x, _
1, _
lProcBodyLine + lProcLineCount - x, _
Len(Trim(.Lines(lProcBodyLine + lProcLineCount -
x, 1))), _
True, True) = False)
370 x = x + 1
380 Loop

'see if we have a function or a sub
'this is not foolproof as there could be comments on that line
'could limit the EndColumn by looking for a ' first, but not
'worth the extra overhead
'-------------------------------------------------------------
390 If .Find("End Function", _
lProcBodyLine + lProcLineCount - x, _
1, _
lProcBodyLine + lProcLineCount - x, _
Len(Trim(.Lines(lProcBodyLine + lProcLineCount - x,
1))), _
True, True) = True Then
'Function
'--------
400 strProcType = "Function"
410 Else
'Sub
'---
420 strProcType = "Sub"
430 End If

440 x = 0

450 Else 'If lProcType = 0
'Property procedure
'------------------
460 Select Case lProcType
Case 1 'Property Set
470 strProcType = "Property Set"
480 Case 2 'Property Let
490 strProcType = "Property Let"
500 Case 3 'Property Get
510 strProcType = "Property Get"
520 End Select
530 End If 'If lProcType = 0

540 collModules.Add VBComp.Name
550 collModulesType.Add CompTypeToName(VBComp)
560 collProcNames.Add strProcName
570 collProcTypes.Add strProcType
580 collProcStartLine.Add lProcBodyLine
590 collProcLineCount.Add lProcLineCount

600 End If
610 Loop

620 End With
630 Next VBComp

640 Application.StatusBar = strStatusIndent & _
"putting the data in the result array"

650 ReDim arrResult(1 To collProcNames.Count, 1 To 6)

660 For i = 1 To collProcNames.Count
670 arrResult(i, 1) = collModules(i)
680 arrResult(i, 2) = collModulesType(i)
690 arrResult(i, 3) = collProcNames(i)
700 arrResult(i, 4) = collProcTypes(i)
710 arrResult(i, 5) = collProcStartLine(i)
720 arrResult(i, 6) = collProcLineCount(i)
730 Next i

740 Application.StatusBar = False

750 GetProcedures = arrResult

760 Exit Function
ERROROUT:

770 Application.StatusBar = False

780 If Err.Number = 9 Then
790 MsgBox VBProj.Filename & " is not open!", , "workbook stats"
800 Else
810 MsgBox Err.Description & vbCrLf & _
"Error number: " & Err.Number & vbCrLf & _
"Error line: " & Erl, , "workbook stats"
820 End If

End Function


Function CompTypeToName(VBComp As VBComponent) As String

Select Case VBComp.Type
Case vbext_ct_ActiveXDesigner
CompTypeToName = "ActiveX Designer"
Case vbext_ct_ClassModule
CompTypeToName = "Class Module"
Case vbext_ct_Document
CompTypeToName = "Document"
Case vbext_ct_MSForm
CompTypeToName = "MS Form"
Case vbext_ct_StdModule
CompTypeToName = "Standard Module"
Case Else
End Select

End Function


RBS


"RB Smissaert" wrote in message
...
This code will remove comments, indentations and blank lines. It will need
a reference to the VBE extensiblity,
Microsoft Visual Basic for Applications Extensibility 5.x. You could put
it in an add-in.

Option Explicit
Private VBProjToClean As VBProject
Private strFileToClean As String

Sub CompactVBEProject()

Dim VBC As VBComponent
Dim WB As Workbook
Dim VBProj As VBProject
Dim strFile As String
Dim msgResult As VbMsgBoxResult

For Each VBProj In Application.VBE.VBProjects
On Error Resume Next
Select Case MsgBox("Compact this file?", _
vbYesNoCancel + vbDefaultButton2, _
VBProj.Filename)
Case vbYes
Set VBProjToClean = VBProj
strFileToClean = VBProj.Filename
Exit For
Case vbNo
Case vbCancel
Exit Sub
End Select
Next

If VBProjToClean Is Nothing Then
Exit Sub
End If

Select Case MsgBox("Do all 3 compacting options?" & _
vbCrLf & vbCrLf & _
"Remove comments" & _
vbCrLf & _
"Remove indentations" & _
vbCrLf & _
"Remove blank lines", _
vbYesNoCancel + vbDefaultButton1, _
strFile)
Case vbYes
VBE_Remove_Comments
VBE_Remove_Indents
VBE_Remove_BlankLines
Case vbNo
Select Case MsgBox("Remove comments from this file?", _
vbYesNoCancel + vbDefaultButton2, strFile)
Case vbYes
VBE_Remove_Comments
Case vbNo
Case vbCancel
Exit Sub
End Select
Select Case MsgBox("Remove indentations from this file?", _
vbYesNoCancel + vbDefaultButton2, strFile)
Case vbYes
VBE_Remove_Indents
Case vbNo
Case vbCancel
Exit Sub
End Select
Select Case MsgBox("Remove blank lines from this file ?", _
vbYesNoCancel + vbDefaultButton2, strFile)
Case vbYes
VBE_Remove_BlankLines
Case vbNo
Case vbCancel
Exit Sub
End Select
Case vbCancel
Exit Sub
End Select

End Sub

Sub VBE_Remove_Comments()

Dim VBC As VBComponent
Dim i As Long
Dim j As Long
Dim str As String
Dim blnStringMode As Boolean
Dim blnLineContinue As Boolean
Dim lCount As Long

With Application
.Cursor = xlWait
.StatusBar = " Removing comments, please wait ..."
End With

For Each VBC In VBProjToClean.VBComponents

blnStringMode = False
i = 1
With VBC.CodeModule

Do Until i .CountOfLines
If Not .ProcOfLine(i, vbext_pk_Proc) = "VBE_Remove_Comments" Then
str = .Lines(i, 1)
blnLineContinue = (Right(str, 2) = " _")

For j = 1 To Len(str)
Select Case Mid(str, j, 1)
Case """": blnStringMode = Not blnStringMode
Case "'"
If Not blnStringMode Then
str = RTrim(Mid(str, 1, j - 1))
If LTrim(str) = "" Then
.DeleteLines i
i = i - 1
lCount = lCount + 1
Else
.ReplaceLine i, str
lCount = lCount + 1
End If

Do While blnLineContinue
blnLineContinue = _
(Right(.Lines(i + 1, 1), 2) = " _")
.DeleteLines i + 1
lCount = lCount + 1
Loop

Exit For
End If
End Select
Next

End If
i = i + 1
Loop
End With
Next

With Application
.Cursor = xlDefault
.StatusBar = False
End With

MsgBox lCount & " comment lines removed", , strFileToClean

End Sub

Sub VBE_Remove_Indents()

Dim VBC As VBComponent
Dim i As Long
Dim j As Long
Dim lCount As Long

With Application
.Cursor = xlWait
.StatusBar = " Removing indentations and trailing spaces, please
wait ..."
End With

For Each VBC In VBProjToClean.VBComponents
With VBC.CodeModule
For i = 1 To .CountOfLines
If Not .ProcOfLine(i, vbext_pk_Proc) = "VBE_Remove_Indents" Then
If Left(.Lines(i, 1), 1) = Chr(32) Then
.ReplaceLine i, _
Replace(.Lines(i, 1), _
.Lines(i, 1), _
Trim$(.Lines(i, 1)), , , _
vbTextCompare)
lCount = lCount + 1
End If
End If
Next
End With
Next

With Application
.Cursor = xlDefault
.StatusBar = False
End With

MsgBox "Removed indentations from " & lCount & " lines", ,
strFileToClean

End Sub

Sub VBE_Remove_BlankLines()

Dim VBC As VBComponent
Dim i As Long
Dim j As Long
Dim lCount As Long

With Application
.Cursor = xlWait
.StatusBar = " Removing blank lines, please wait ..."
End With

For Each VBC In VBProjToClean.VBComponents
With VBC.CodeModule
For i = .CountOfLines To 1 Step -1
If Not .ProcOfLine(i, vbext_pk_Proc) = "VBE_Remove_BlankLines" Then
If Len(Trim(.Lines(i, 1))) = 0 Then
.DeleteLines i
lCount = lCount + 1
End If
End If
Next
End With
Next

With Application
.Cursor = xlDefault
.StatusBar = False
End With

MsgBox "Removed " & lCount & " blank lines", , strFileToClean

End Sub


To scramble all Procedure names shouldn't be too difficult either.
Have a look at this website to learn about manipulating the VBE:
http://www.cpearson.com/excel/vbe.aspx


RBS





"MikeZz" wrote in message
...
Hi,
I have an excel VBA application that I'm considering to sell at some
point.

As a deterant to any unauthorized usage, I was wondering if it's possible
through VBA to completely remove all comments and rename all the routines
and
functions in all modules and forms with unrecogizable names so that the
code
would work yet be vertutally impossible to understand.

Thanks for any help!
MikeZz




  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 152
Default Programatically remove VBA Comments & Rename Functions & Routi

Hi RB,
This is pretty helpful as well.
I did notice that the Compactor didn't clean any code found in the forms.
Is there an easy way to do that as well or should I just copy it all to a
module, run the application, then copy it back to the form?

Thanks again for everything
MikeZz

"RB Smissaert" wrote:

Here a trimmed down version of a VB project documenter I once uploaded to
Planet Source Code.
Once you have all the procedures then it shouldn't be too difficult to
replace with a scrambled name and
do the replacements in the VBE.

Sub test()

Dim VBProj As VBProject
Dim arr

For Each VBProj In Application.VBE.VBProjects
On Error Resume Next
Select Case MsgBox("Document this file?", _
vbYesNoCancel + vbDefaultButton2, _
VBProj.Filename)
Case vbYes
arr = GetProcedures(VBProj)
Exit For
Case vbNo
Case vbCancel
Exit Sub
End Select
Next

If Not IsArray(arr) Then
Exit Sub
End If

Application.ScreenUpdating = False

Cells.Clear
Cells(1) = "Module name"
Cells(2) = "Module type"
Cells(3) = "Procedure name"
Cells(4) = "Procedure type"
Cells(5) = "Procedure start"
Cells(6) = "Procedure lines"

Range(Cells(1), Cells(6)).Font.Bold = True
Range(Cells(2, 1), Cells(UBound(arr) + 1, UBound(arr, 2))) = arr
Range(Cells(1), Cells(UBound(arr) + 1, UBound(arr, 2))).Columns.AutoFit

Application.ScreenUpdating = True

End Sub


Function GetProcedures(VBProj As VBProject) As Variant

Dim i As Long
Dim x As Long
Dim strStatusIndent As String
Dim VBComp As VBComponent
Dim lCodeLine As Long
Dim lProcBodyLine As Long
Dim lProcLineCount As Long
Dim strProcName As String
Dim strProcType As String
Dim strProcNamePrevious As String
Dim lProcType As Long
Dim lProcTypePrevious As Long
Dim lModules As Long
Dim lModuleCount As Long
Dim lModuleLineCount As Long
Dim collModules As Collection
Dim collModulesType As Collection
Dim collProcNames As Collection
Dim collProcTypes As Collection
Dim collProcStartLine As Collection
Dim collProcLineCount As Collection
Dim strWBType As String
Dim arrResult

10 If UCase(Right$(VBProj.Filename, 3)) = "XLA" Then
20 strWBType = "add-in"
30 Else
40 strWBType = "workbook"
50 End If

60 On Error Resume Next
70 lModules = VBProj.VBComponents.Count

80 If Err.Number = 50289 Then
90 MsgBox "Can't document this " & strWBType & _
" as it is protected", , VBProj.Filename
100 Exit Function
110 End If

120 On Error GoTo ERROROUT

130 strStatusIndent = " "

140 Set collModules = New Collection
150 Set collModulesType = New Collection
160 Set collProcNames = New Collection
170 Set collProcTypes = New Collection
180 Set collProcStartLine = New Collection
190 Set collProcLineCount = New Collection

200 For Each VBComp In VBProj.VBComponents

210 Application.StatusBar = strStatusIndent & "doing module " &
VBComp.Name

220 DoEvents
230 lModuleCount = lModuleCount + 1
240 DoEvents

250 With VBComp.CodeModule

'if we don't start past the declarations it will crash as it is now
'------------------------------------------------------------------
260 lCodeLine = .CountOfDeclarationLines

270 Do Until lCodeLine = .CountOfLines

280 lCodeLine = lCodeLine + 1

290 strProcName = .ProcOfLine(lCodeLine, lProcType)

'we have to catch Property procedures that have the same name
'------------------------------------------------------------
300 If strProcName < strProcNamePrevious Or _
lProcType < lProcTypePrevious Then

310 strProcNamePrevious = strProcName
320 lProcTypePrevious = lProcType
330 lProcBodyLine = .ProcBodyLine(strProcName, lProcType)
340 lProcLineCount = .ProcCountLines(strProcName, lProcType)

350 If lProcType = 0 Then
'Sub or Function, unfortunately ProcType can't differentiate
these
'-----------------------------------------------------------------

'find the real end of the procedure
'comments at the end belong to the procedure!
'note that this will fail without the len bit
'--------------------------------------------
360 Do While Len(Trim(.Lines(lProcBodyLine + lProcLineCount - x,
1))) = 0 Or _
(.Find("End Sub", _
lProcBodyLine + lProcLineCount - x, _
1, _
lProcBodyLine + lProcLineCount - x, _
Len(Trim(.Lines(lProcBodyLine + lProcLineCount - x,
1))), _
True, True) = False And _
.Find("End Function", _
lProcBodyLine + lProcLineCount - x, _
1, _
lProcBodyLine + lProcLineCount - x, _
Len(Trim(.Lines(lProcBodyLine + lProcLineCount -
x, 1))), _
True, True) = False)
370 x = x + 1
380 Loop

'see if we have a function or a sub
'this is not foolproof as there could be comments on that line
'could limit the EndColumn by looking for a ' first, but not
'worth the extra overhead
'-------------------------------------------------------------
390 If .Find("End Function", _
lProcBodyLine + lProcLineCount - x, _
1, _
lProcBodyLine + lProcLineCount - x, _
Len(Trim(.Lines(lProcBodyLine + lProcLineCount - x,
1))), _
True, True) = True Then
'Function
'--------
400 strProcType = "Function"
410 Else
'Sub
'---
420 strProcType = "Sub"
430 End If

440 x = 0

450 Else 'If lProcType = 0
'Property procedure
'------------------
460 Select Case lProcType
Case 1 'Property Set
470 strProcType = "Property Set"
480 Case 2 'Property Let
490 strProcType = "Property Let"
500 Case 3 'Property Get
510 strProcType = "Property Get"
520 End Select
530 End If 'If lProcType = 0

540 collModules.Add VBComp.Name
550 collModulesType.Add CompTypeToName(VBComp)
560 collProcNames.Add strProcName
570 collProcTypes.Add strProcType
580 collProcStartLine.Add lProcBodyLine
590 collProcLineCount.Add lProcLineCount

600 End If
610 Loop

620 End With
630 Next VBComp

640 Application.StatusBar = strStatusIndent & _
"putting the data in the result array"

650 ReDim arrResult(1 To collProcNames.Count, 1 To 6)

660 For i = 1 To collProcNames.Count
670 arrResult(i, 1) = collModules(i)
680 arrResult(i, 2) = collModulesType(i)
690 arrResult(i, 3) = collProcNames(i)
700 arrResult(i, 4) = collProcTypes(i)
710 arrResult(i, 5) = collProcStartLine(i)
720 arrResult(i, 6) = collProcLineCount(i)
730 Next i

740 Application.StatusBar = False

750 GetProcedures = arrResult

760 Exit Function
ERROROUT:

770 Application.StatusBar = False

780 If Err.Number = 9 Then
790 MsgBox VBProj.Filename & " is not open!", , "workbook stats"
800 Else
810 MsgBox Err.Description & vbCrLf & _
"Error number: " & Err.Number & vbCrLf & _
"Error line: " & Erl, , "workbook stats"
820 End If

End Function


Function CompTypeToName(VBComp As VBComponent) As String

Select Case VBComp.Type
Case vbext_ct_ActiveXDesigner
CompTypeToName = "ActiveX Designer"
Case vbext_ct_ClassModule
CompTypeToName = "Class Module"
Case vbext_ct_Document
CompTypeToName = "Document"
Case vbext_ct_MSForm
CompTypeToName = "MS Form"
Case vbext_ct_StdModule
CompTypeToName = "Standard Module"
Case Else
End Select

End Function


RBS


"RB Smissaert" wrote in message
...
This code will remove comments, indentations and blank lines. It will need
a reference to the VBE extensiblity,
Microsoft Visual Basic for Applications Extensibility 5.x. You could put
it in an add-in.

Option Explicit
Private VBProjToClean As VBProject
Private strFileToClean As String

Sub CompactVBEProject()

Dim VBC As VBComponent
Dim WB As Workbook
Dim VBProj As VBProject
Dim strFile As String
Dim msgResult As VbMsgBoxResult

For Each VBProj In Application.VBE.VBProjects
On Error Resume Next
Select Case MsgBox("Compact this file?", _
vbYesNoCancel + vbDefaultButton2, _
VBProj.Filename)
Case vbYes
Set VBProjToClean = VBProj
strFileToClean = VBProj.Filename
Exit For
Case vbNo
Case vbCancel
Exit Sub
End Select
Next

If VBProjToClean Is Nothing Then
Exit Sub

  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,452
Default Programatically remove VBA Comments & Rename Functions & Routi

I did notice that the Compactor didn't clean any code found in the forms

It should do and does with me.
Maybe download the add-in I uploaded to Planet Source Code some years ago
that has this in it:
http://www.planet-source-code.com/vb...33284&lngWId=1

RBS


"MikeZz" wrote in message
...
Hi RB,
This is pretty helpful as well.
I did notice that the Compactor didn't clean any code found in the forms.
Is there an easy way to do that as well or should I just copy it all to a
module, run the application, then copy it back to the form?

Thanks again for everything
MikeZz

"RB Smissaert" wrote:

Here a trimmed down version of a VB project documenter I once uploaded to
Planet Source Code.
Once you have all the procedures then it shouldn't be too difficult to
replace with a scrambled name and
do the replacements in the VBE.

Sub test()

Dim VBProj As VBProject
Dim arr

For Each VBProj In Application.VBE.VBProjects
On Error Resume Next
Select Case MsgBox("Document this file?", _
vbYesNoCancel + vbDefaultButton2, _
VBProj.Filename)
Case vbYes
arr = GetProcedures(VBProj)
Exit For
Case vbNo
Case vbCancel
Exit Sub
End Select
Next

If Not IsArray(arr) Then
Exit Sub
End If

Application.ScreenUpdating = False

Cells.Clear
Cells(1) = "Module name"
Cells(2) = "Module type"
Cells(3) = "Procedure name"
Cells(4) = "Procedure type"
Cells(5) = "Procedure start"
Cells(6) = "Procedure lines"

Range(Cells(1), Cells(6)).Font.Bold = True
Range(Cells(2, 1), Cells(UBound(arr) + 1, UBound(arr, 2))) = arr
Range(Cells(1), Cells(UBound(arr) + 1, UBound(arr, 2))).Columns.AutoFit

Application.ScreenUpdating = True

End Sub


Function GetProcedures(VBProj As VBProject) As Variant

Dim i As Long
Dim x As Long
Dim strStatusIndent As String
Dim VBComp As VBComponent
Dim lCodeLine As Long
Dim lProcBodyLine As Long
Dim lProcLineCount As Long
Dim strProcName As String
Dim strProcType As String
Dim strProcNamePrevious As String
Dim lProcType As Long
Dim lProcTypePrevious As Long
Dim lModules As Long
Dim lModuleCount As Long
Dim lModuleLineCount As Long
Dim collModules As Collection
Dim collModulesType As Collection
Dim collProcNames As Collection
Dim collProcTypes As Collection
Dim collProcStartLine As Collection
Dim collProcLineCount As Collection
Dim strWBType As String
Dim arrResult

10 If UCase(Right$(VBProj.Filename, 3)) = "XLA" Then
20 strWBType = "add-in"
30 Else
40 strWBType = "workbook"
50 End If

60 On Error Resume Next
70 lModules = VBProj.VBComponents.Count

80 If Err.Number = 50289 Then
90 MsgBox "Can't document this " & strWBType & _
" as it is protected", , VBProj.Filename
100 Exit Function
110 End If

120 On Error GoTo ERROROUT

130 strStatusIndent = " "

140 Set collModules = New Collection
150 Set collModulesType = New Collection
160 Set collProcNames = New Collection
170 Set collProcTypes = New Collection
180 Set collProcStartLine = New Collection
190 Set collProcLineCount = New Collection

200 For Each VBComp In VBProj.VBComponents

210 Application.StatusBar = strStatusIndent & "doing module " &
VBComp.Name

220 DoEvents
230 lModuleCount = lModuleCount + 1
240 DoEvents

250 With VBComp.CodeModule

'if we don't start past the declarations it will crash as it is
now

'------------------------------------------------------------------
260 lCodeLine = .CountOfDeclarationLines

270 Do Until lCodeLine = .CountOfLines

280 lCodeLine = lCodeLine + 1

290 strProcName = .ProcOfLine(lCodeLine, lProcType)

'we have to catch Property procedures that have the same name
'------------------------------------------------------------
300 If strProcName < strProcNamePrevious Or _
lProcType < lProcTypePrevious Then

310 strProcNamePrevious = strProcName
320 lProcTypePrevious = lProcType
330 lProcBodyLine = .ProcBodyLine(strProcName, lProcType)
340 lProcLineCount = .ProcCountLines(strProcName, lProcType)

350 If lProcType = 0 Then
'Sub or Function, unfortunately ProcType can't differentiate
these

'-----------------------------------------------------------------

'find the real end of the procedure
'comments at the end belong to the procedure!
'note that this will fail without the len bit
'--------------------------------------------
360 Do While Len(Trim(.Lines(lProcBodyLine + lProcLineCount - x,
1))) = 0 Or _
(.Find("End Sub", _
lProcBodyLine + lProcLineCount - x, _
1, _
lProcBodyLine + lProcLineCount - x, _
Len(Trim(.Lines(lProcBodyLine + lProcLineCount - x,
1))), _
True, True) = False And _
.Find("End Function", _
lProcBodyLine + lProcLineCount - x, _
1, _
lProcBodyLine + lProcLineCount - x, _
Len(Trim(.Lines(lProcBodyLine +
lProcLineCount -
x, 1))), _
True, True) = False)
370 x = x + 1
380 Loop

'see if we have a function or a sub
'this is not foolproof as there could be comments on that
line
'could limit the EndColumn by looking for a ' first, but not
'worth the extra overhead

'-------------------------------------------------------------
390 If .Find("End Function", _
lProcBodyLine + lProcLineCount - x, _
1, _
lProcBodyLine + lProcLineCount - x, _
Len(Trim(.Lines(lProcBodyLine + lProcLineCount - x,
1))), _
True, True) = True Then
'Function
'--------
400 strProcType = "Function"
410 Else
'Sub
'---
420 strProcType = "Sub"
430 End If

440 x = 0

450 Else 'If lProcType = 0
'Property procedure
'------------------
460 Select Case lProcType
Case 1 'Property Set
470 strProcType = "Property Set"
480 Case 2 'Property Let
490 strProcType = "Property Let"
500 Case 3 'Property Get
510 strProcType = "Property Get"
520 End Select
530 End If 'If lProcType = 0

540 collModules.Add VBComp.Name
550 collModulesType.Add CompTypeToName(VBComp)
560 collProcNames.Add strProcName
570 collProcTypes.Add strProcType
580 collProcStartLine.Add lProcBodyLine
590 collProcLineCount.Add lProcLineCount

600 End If
610 Loop

620 End With
630 Next VBComp

640 Application.StatusBar = strStatusIndent & _
"putting the data in the result array"

650 ReDim arrResult(1 To collProcNames.Count, 1 To 6)

660 For i = 1 To collProcNames.Count
670 arrResult(i, 1) = collModules(i)
680 arrResult(i, 2) = collModulesType(i)
690 arrResult(i, 3) = collProcNames(i)
700 arrResult(i, 4) = collProcTypes(i)
710 arrResult(i, 5) = collProcStartLine(i)
720 arrResult(i, 6) = collProcLineCount(i)
730 Next i

740 Application.StatusBar = False

750 GetProcedures = arrResult

760 Exit Function
ERROROUT:

770 Application.StatusBar = False

780 If Err.Number = 9 Then
790 MsgBox VBProj.Filename & " is not open!", , "workbook stats"
800 Else
810 MsgBox Err.Description & vbCrLf & _
"Error number: " & Err.Number & vbCrLf & _
"Error line: " & Erl, , "workbook stats"
820 End If

End Function


Function CompTypeToName(VBComp As VBComponent) As String

Select Case VBComp.Type
Case vbext_ct_ActiveXDesigner
CompTypeToName = "ActiveX Designer"
Case vbext_ct_ClassModule
CompTypeToName = "Class Module"
Case vbext_ct_Document
CompTypeToName = "Document"
Case vbext_ct_MSForm
CompTypeToName = "MS Form"
Case vbext_ct_StdModule
CompTypeToName = "Standard Module"
Case Else
End Select

End Function


RBS


"RB Smissaert" wrote in message
...
This code will remove comments, indentations and blank lines. It will
need
a reference to the VBE extensiblity,
Microsoft Visual Basic for Applications Extensibility 5.x. You could
put
it in an add-in.

Option Explicit
Private VBProjToClean As VBProject
Private strFileToClean As String

Sub CompactVBEProject()

Dim VBC As VBComponent
Dim WB As Workbook
Dim VBProj As VBProject
Dim strFile As String
Dim msgResult As VbMsgBoxResult

For Each VBProj In Application.VBE.VBProjects
On Error Resume Next
Select Case MsgBox("Compact this file?", _
vbYesNoCancel + vbDefaultButton2, _
VBProj.Filename)
Case vbYes
Set VBProjToClean = VBProj
strFileToClean = VBProj.Filename
Exit For
Case vbNo
Case vbCancel
Exit Sub
End Select
Next

If VBProjToClean Is Nothing Then
Exit Sub


  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 152
Default Programatically remove VBA Comments & Rename Functions & Routi

Hi RB,
Thanks, this works really well.
The only strange thing is that when I run in the first time,
it errors when calling the Remove Indent procedure...
Says that VBC is not properly defined... although it clearly seems to be.

Then after I "End" and run the Compact sub again, it works like a charm.
Strange.

Thanks again!

"RB Smissaert" wrote:

This code will remove comments, indentations and blank lines. It will need a
reference to the VBE extensiblity,
Microsoft Visual Basic for Applications Extensibility 5.x. You could put it
in an add-in.

Option Explicit
Private VBProjToClean As VBProject
Private strFileToClean As String

Sub CompactVBEProject()

Dim VBC As VBComponent
Dim WB As Workbook
Dim VBProj As VBProject
Dim strFile As String
Dim msgResult As VbMsgBoxResult

For Each VBProj In Application.VBE.VBProjects
On Error Resume Next
Select Case MsgBox("Compact this file?", _
vbYesNoCancel + vbDefaultButton2, _
VBProj.Filename)
Case vbYes
Set VBProjToClean = VBProj
strFileToClean = VBProj.Filename
Exit For
Case vbNo
Case vbCancel
Exit Sub
End Select
Next

If VBProjToClean Is Nothing Then
Exit Sub
End If

Select Case MsgBox("Do all 3 compacting options?" & _
vbCrLf & vbCrLf & _
"Remove comments" & _
vbCrLf & _
"Remove indentations" & _
vbCrLf & _
"Remove blank lines", _
vbYesNoCancel + vbDefaultButton1, _
strFile)
Case vbYes
VBE_Remove_Comments
VBE_Remove_Indents
VBE_Remove_BlankLines
Case vbNo
Select Case MsgBox("Remove comments from this file?", _
vbYesNoCancel + vbDefaultButton2, strFile)
Case vbYes
VBE_Remove_Comments
Case vbNo
Case vbCancel
Exit Sub
End Select
Select Case MsgBox("Remove indentations from this file?", _
vbYesNoCancel + vbDefaultButton2, strFile)
Case vbYes
VBE_Remove_Indents
Case vbNo
Case vbCancel
Exit Sub
End Select
Select Case MsgBox("Remove blank lines from this file ?", _
vbYesNoCancel + vbDefaultButton2, strFile)
Case vbYes
VBE_Remove_BlankLines
Case vbNo
Case vbCancel
Exit Sub
End Select
Case vbCancel
Exit Sub
End Select

End Sub

Sub VBE_Remove_Comments()

Dim VBC As VBComponent
Dim i As Long
Dim j As Long
Dim str As String
Dim blnStringMode As Boolean
Dim blnLineContinue As Boolean
Dim lCount As Long

With Application
.Cursor = xlWait
.StatusBar = " Removing comments, please wait ..."
End With

For Each VBC In VBProjToClean.VBComponents

blnStringMode = False
i = 1
With VBC.CodeModule

Do Until i .CountOfLines
If Not .ProcOfLine(i, vbext_pk_Proc) = "VBE_Remove_Comments" Then
str = .Lines(i, 1)
blnLineContinue = (Right(str, 2) = " _")

For j = 1 To Len(str)
Select Case Mid(str, j, 1)
Case """": blnStringMode = Not blnStringMode
Case "'"
If Not blnStringMode Then
str = RTrim(Mid(str, 1, j - 1))
If LTrim(str) = "" Then
.DeleteLines i
i = i - 1
lCount = lCount + 1
Else
.ReplaceLine i, str
lCount = lCount + 1
End If

Do While blnLineContinue
blnLineContinue = _
(Right(.Lines(i + 1, 1), 2) = " _")
.DeleteLines i + 1
lCount = lCount + 1
Loop

Exit For
End If
End Select
Next

End If
i = i + 1
Loop
End With
Next

With Application
.Cursor = xlDefault
.StatusBar = False
End With

MsgBox lCount & " comment lines removed", , strFileToClean

End Sub

Sub VBE_Remove_Indents()

Dim VBC As VBComponent
Dim i As Long
Dim j As Long
Dim lCount As Long

With Application
.Cursor = xlWait
.StatusBar = " Removing indentations and trailing spaces, please
wait ..."
End With

For Each VBC In VBProjToClean.VBComponents
With VBC.CodeModule
For i = 1 To .CountOfLines
If Not .ProcOfLine(i, vbext_pk_Proc) = "VBE_Remove_Indents" Then
If Left(.Lines(i, 1), 1) = Chr(32) Then
.ReplaceLine i, _
Replace(.Lines(i, 1), _
.Lines(i, 1), _
Trim$(.Lines(i, 1)), , , _
vbTextCompare)
lCount = lCount + 1
End If
End If
Next
End With
Next

With Application
.Cursor = xlDefault
.StatusBar = False
End With

MsgBox "Removed indentations from " & lCount & " lines", ,
strFileToClean

End Sub

Sub VBE_Remove_BlankLines()

Dim VBC As VBComponent
Dim i As Long
Dim j As Long
Dim lCount As Long

With Application
.Cursor = xlWait
.StatusBar = " Removing blank lines, please wait ..."
End With

For Each VBC In VBProjToClean.VBComponents
With VBC.CodeModule
For i = .CountOfLines To 1 Step -1
If Not .ProcOfLine(i, vbext_pk_Proc) = "VBE_Remove_BlankLines" Then
If Len(Trim(.Lines(i, 1))) = 0 Then
.DeleteLines i
lCount = lCount + 1
End If
End If
Next
End With
Next

With Application
.Cursor = xlDefault
.StatusBar = False
End With

MsgBox "Removed " & lCount & " blank lines", , strFileToClean

End Sub


To scramble all Procedure names shouldn't be too difficult either.
Have a look at this website to learn about manipulating the VBE:
http://www.cpearson.com/excel/vbe.aspx


RBS





"MikeZz" wrote in message
...
Hi,
I have an excel VBA application that I'm considering to sell at some
point.

As a deterant to any unauthorized usage, I was wondering if it's possible
through VBA to completely remove all comments and rename all the routines
and
functions in all modules and forms with unrecogizable names so that the
code
would work yet be vertutally impossible to understand.

Thanks for any help!
MikeZz




  #10   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,452
Default Programatically remove VBA Comments & Rename Functions & Routi

Will have a look. As posted earlier, maybe download the add-in that
has this in it.

RBS

"MikeZz" wrote in message
...
Hi RB,
Thanks, this works really well.
The only strange thing is that when I run in the first time,
it errors when calling the Remove Indent procedure...
Says that VBC is not properly defined... although it clearly seems to be.

Then after I "End" and run the Compact sub again, it works like a charm.
Strange.

Thanks again!

"RB Smissaert" wrote:

This code will remove comments, indentations and blank lines. It will
need a
reference to the VBE extensiblity,
Microsoft Visual Basic for Applications Extensibility 5.x. You could put
it
in an add-in.

Option Explicit
Private VBProjToClean As VBProject
Private strFileToClean As String

Sub CompactVBEProject()

Dim VBC As VBComponent
Dim WB As Workbook
Dim VBProj As VBProject
Dim strFile As String
Dim msgResult As VbMsgBoxResult

For Each VBProj In Application.VBE.VBProjects
On Error Resume Next
Select Case MsgBox("Compact this file?", _
vbYesNoCancel + vbDefaultButton2, _
VBProj.Filename)
Case vbYes
Set VBProjToClean = VBProj
strFileToClean = VBProj.Filename
Exit For
Case vbNo
Case vbCancel
Exit Sub
End Select
Next

If VBProjToClean Is Nothing Then
Exit Sub
End If

Select Case MsgBox("Do all 3 compacting options?" & _
vbCrLf & vbCrLf & _
"Remove comments" & _
vbCrLf & _
"Remove indentations" & _
vbCrLf & _
"Remove blank lines", _
vbYesNoCancel + vbDefaultButton1, _
strFile)
Case vbYes
VBE_Remove_Comments
VBE_Remove_Indents
VBE_Remove_BlankLines
Case vbNo
Select Case MsgBox("Remove comments from this file?", _
vbYesNoCancel + vbDefaultButton2, strFile)
Case vbYes
VBE_Remove_Comments
Case vbNo
Case vbCancel
Exit Sub
End Select
Select Case MsgBox("Remove indentations from this file?", _
vbYesNoCancel + vbDefaultButton2, strFile)
Case vbYes
VBE_Remove_Indents
Case vbNo
Case vbCancel
Exit Sub
End Select
Select Case MsgBox("Remove blank lines from this file ?", _
vbYesNoCancel + vbDefaultButton2, strFile)
Case vbYes
VBE_Remove_BlankLines
Case vbNo
Case vbCancel
Exit Sub
End Select
Case vbCancel
Exit Sub
End Select

End Sub

Sub VBE_Remove_Comments()

Dim VBC As VBComponent
Dim i As Long
Dim j As Long
Dim str As String
Dim blnStringMode As Boolean
Dim blnLineContinue As Boolean
Dim lCount As Long

With Application
.Cursor = xlWait
.StatusBar = " Removing comments, please wait ..."
End With

For Each VBC In VBProjToClean.VBComponents

blnStringMode = False
i = 1
With VBC.CodeModule

Do Until i .CountOfLines
If Not .ProcOfLine(i, vbext_pk_Proc) = "VBE_Remove_Comments" Then
str = .Lines(i, 1)
blnLineContinue = (Right(str, 2) = " _")

For j = 1 To Len(str)
Select Case Mid(str, j, 1)
Case """": blnStringMode = Not blnStringMode
Case "'"
If Not blnStringMode Then
str = RTrim(Mid(str, 1, j - 1))
If LTrim(str) = "" Then
.DeleteLines i
i = i - 1
lCount = lCount + 1
Else
.ReplaceLine i, str
lCount = lCount + 1
End If

Do While blnLineContinue
blnLineContinue = _
(Right(.Lines(i + 1, 1), 2) = " _")
.DeleteLines i + 1
lCount = lCount + 1
Loop

Exit For
End If
End Select
Next

End If
i = i + 1
Loop
End With
Next

With Application
.Cursor = xlDefault
.StatusBar = False
End With

MsgBox lCount & " comment lines removed", , strFileToClean

End Sub

Sub VBE_Remove_Indents()

Dim VBC As VBComponent
Dim i As Long
Dim j As Long
Dim lCount As Long

With Application
.Cursor = xlWait
.StatusBar = " Removing indentations and trailing spaces,
please
wait ..."
End With

For Each VBC In VBProjToClean.VBComponents
With VBC.CodeModule
For i = 1 To .CountOfLines
If Not .ProcOfLine(i, vbext_pk_Proc) = "VBE_Remove_Indents" Then
If Left(.Lines(i, 1), 1) = Chr(32) Then
.ReplaceLine i, _
Replace(.Lines(i, 1), _
.Lines(i, 1), _
Trim$(.Lines(i, 1)), , , _
vbTextCompare)
lCount = lCount + 1
End If
End If
Next
End With
Next

With Application
.Cursor = xlDefault
.StatusBar = False
End With

MsgBox "Removed indentations from " & lCount & " lines", ,
strFileToClean

End Sub

Sub VBE_Remove_BlankLines()

Dim VBC As VBComponent
Dim i As Long
Dim j As Long
Dim lCount As Long

With Application
.Cursor = xlWait
.StatusBar = " Removing blank lines, please wait ..."
End With

For Each VBC In VBProjToClean.VBComponents
With VBC.CodeModule
For i = .CountOfLines To 1 Step -1
If Not .ProcOfLine(i, vbext_pk_Proc) = "VBE_Remove_BlankLines"
Then
If Len(Trim(.Lines(i, 1))) = 0 Then
.DeleteLines i
lCount = lCount + 1
End If
End If
Next
End With
Next

With Application
.Cursor = xlDefault
.StatusBar = False
End With

MsgBox "Removed " & lCount & " blank lines", , strFileToClean

End Sub


To scramble all Procedure names shouldn't be too difficult either.
Have a look at this website to learn about manipulating the VBE:
http://www.cpearson.com/excel/vbe.aspx


RBS





"MikeZz" wrote in message
...
Hi,
I have an excel VBA application that I'm considering to sell at some
point.

As a deterant to any unauthorized usage, I was wondering if it's
possible
through VBA to completely remove all comments and rename all the
routines
and
functions in all modules and forms with unrecogizable names so that the
code
would work yet be vertutally impossible to understand.

Thanks for any help!
MikeZz







Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Excel Statistical Functions and Routines David A. Heiser Excel Worksheet Functions 0 June 3rd 05 05:27 PM
Excel Statistical Functions and Routines David A. Heiser Excel Worksheet Functions 1 June 2nd 05 03:52 AM
Programatically Rename Tabs Karl Burrows[_2_] Excel Programming 1 February 21st 05 01:00 PM
Programatically retrieve a list of public functions. Alan Howells Excel Programming 4 October 21st 03 02:28 PM
Rename a Range, programatically? plh[_2_] Excel Programming 0 September 4th 03 05:11 PM


All times are GMT +1. The time now is 08:11 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"