For those who still uses VB 6 and have to deal with unindented code...
I have created this Visual Basic Addin some time ago to solve a recurring problem I used to have: Deal with big projects with unindented code anywhere. I am not sure it covers 100% VB 6 syntax because I did not find any "VB 6 reserved keywords" list on Internet that time. So try it and extend it in case any keyword is missing.
'TidyVBCode.vbp
'--------------------------------------------------------------------------------------
Type=OleDll
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\System32\stdole2.tlb#OLE
Automation
Reference=*\G{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}#2.0#0#..\..\Arquivos
de programas\Arquivos comuns\Microsoft
Shared\Office10\MSO.DLL#Microsoft Office 8.0 Object
Library
Reference=*\G{AC0714F2-3D04-11D1-AE7D-00A0C90F26F4}#1.0#0#..\..\Arquivos
de programas\Arquivos comuns\Designer\msaddndr.dll#Add-In
Designer/Instance Control Library
Reference=*\G{EF404E00-EDA6-101A-8DAF-00DD010F7EBB}#5.3#0#..\..\Arquivos
de programas\Microsoft Visual
Studio\VB98\VB6EXT.OLB#Microsoft Visual Basic 6.0
Extensibility
Form=TidyVBCode.frm
Designer=TidyVBCode.Dsr
Reference=*\G{00000205-0000-0010-8000-00AA006D2EA4}#2.5#0#..\..\Arquivos
de programas\Arquivos
comuns\System\ADO\msado25.tlb#Microsoft ActiveX Data
Objects 2.5 Library
Startup="(None)"
HelpFile=""
Title="TidyVBCode"
ExeName32="TidyVBCode.dll"
Path32="..\system32"
Command32=""
Name="TidyVBCode"
HelpContextID="0"
Description="Tidy
VB Code written by Luciano Evaristo Guerche"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=85
AutoIncrementVer=1
ServerSupportFiles=0
VersionCompanyName="Visanet"
VersionLegalCopyright="©2002,
Luciano Evaristo Guerche"
VersionProductName="Tidy VB
Code written by Luciano Evaristo Guerche"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=1
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
DebugStartupOption=0
[MS Transaction Server]
AutoRefresh=1
'TidyVBCode.Dsr
'--------------------------------------------------------------------------------------
VERSION
5.00
Begin {AC0714F6-3D04-11D1-AE7D-00A0C90F26F4}
Connect
ClientHeight = 5475
ClientLeft = 1740
ClientTop =
1545
ClientWidth = 6405
_ExtentX = 11298
_ExtentY =
9657
_Version = 393216
Description = "Tidy VB Code written by Luciano
Evaristo Guerche"
DisplayName = "Tidy VB
Code"
AppName = "Visual Basic"
AppVer = "Visual Basic 98 (ver 6.0)"
LoadName = "Command Line / Startup"
LoadBehavior = 5
RegLocation =
"HKEY_CURRENT_USER\Software\Microsoft\Visual Basic\6.0"
CmdLineSupport = -1 'True
End
Attribute
VB_Name = "Connect"
Attribute VB_GlobalNameSpace =
False
Attribute VB_Creatable = True
Attribute
VB_PredeclaredId = False
Attribute VB_Exposed =
True
Option Explicit
Public FormDisplayed As Boolean
Public
VBInstance As VBIDE.VBE
Public
WithEvents MenuHandler As CommandBarEvents
'command bar event handler
Attribute
MenuHandler.VB_VarHelpID = -1
Private mcbMenuCommandBar As
Office.CommandBarControl
Private mfrmTidyVBCode
As New frmTidyVBCode
Sub Hide()
On Error Resume Next
FormDisplayed = False
mfrmTidyVBCode.Hide
End
Sub
Sub Show()
On Error Resume Next
If mfrmTidyVBCode Is Nothing Then
Set
mfrmTidyVBCode = New frmTidyVBCode
End If
Set mfrmTidyVBCode.VBInstance = VBInstance
Set mfrmTidyVBCode.Connect = Me
FormDisplayed =
True
mfrmTidyVBCode.Show
End Sub
'------------------------------------------------------
'this
method adds the Add-In to VB
'------------------------------------------------------
Private Sub AddinInstance_OnConnection(ByVal Application
As Object, ByVal ConnectMode As
AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As
Object, custom() As Variant)
On Error GoTo
error_handler
' save the vb instance
Set VBInstance =
Application
' this is a good place to set a breakpoint and
'
test various addin objects, properties and methods
Debug.Print VBInstance.FullName
If ConnectMode = ext_cm_External Then
'
Used by the wizard toolbar to start this wizard
Me.Show
Else
Set mcbMenuCommandBar =
AddToAddInCommandBar("Tidy VB Code written by Luciano
Evaristo Guerche")
' sink the event
Set Me.MenuHandler =
VBInstance.Events.CommandBarEvents(mcbMenuCommandBar)
End If
If ConnectMode = ext_cm_AfterStartup Then
If GetSetting(App.Title, "Settings", "DisplayOnConnect",
"0") = "1" Then
' set this to display the
form on connect
Me.Show
End
If
End If
Exit Sub
error_handler:
MsgBox Err.Description
End Sub
'------------------------------------------------------
'this
method removes the Add-In from VB
'------------------------------------------------------
Private Sub AddinInstance_OnDisconnection(ByVal
RemoveMode As AddInDesignerObjects.ext_DisconnectMode,
custom() As Variant)
On Error Resume Next
' delete the command bar entry
mcbMenuCommandBar.Delete
' shut down the Add-In
If FormDisplayed
Then
SaveSetting App.Title, "Settings",
"DisplayOnConnect", "1"
FormDisplayed =
False
Else
SaveSetting App.Title,
"Settings", "DisplayOnConnect", "0"
End If
Unload mfrmTidyVBCode
Set mfrmTidyVBCode =
Nothing
End Sub
Private Sub IDTExtensibility_OnStartupComplete(custom()
As Variant)
If GetSetting(App.Title, "Settings",
"DisplayOnConnect", "0") = "1" Then
' set this
to display the form on connect
Me.Show
End If
End Sub
'this event fires when the menu is clicked in the IDE
Private Sub MenuHandler_Click(ByVal CommandBarControl As
Object, handled As Boolean, CancelDefault As Boolean)
Me.Show
End Sub
Function AddToAddInCommandBar(sCaption As String) As
Office.CommandBarControl
Dim cbMenuCommandBar As
Office.CommandBarControl 'command bar object
Dim
cbMenu As Object
On Error GoTo AddToAddInCommandBarErr
' see if we can find the Add-Ins menu
Set
cbMenu = VBInstance.CommandBars("Add-Ins")
If
cbMenu Is Nothing Then
' not available so we
fail
Exit Function
End If
' add it to the command bar
Set
cbMenuCommandBar = cbMenu.Controls.Add(1)
' set the
caption
cbMenuCommandBar.Caption = sCaption
Set AddToAddInCommandBar = cbMenuCommandBar
Exit Function
AddToAddInCommandBarErr:
End Function
'TidyVBCode.frm
'--------------------------------------------------------------------------------------
VERSION
5.00
Begin VB.Form frmTidyVBCode
BorderStyle = 3 'Fixed Dialog
Caption = "Tidy VB Code written by Luciano
Evaristo Guerche"
ClientHeight = 780
ClientLeft = 2175
ClientTop =
1935
ClientWidth = 5400
LinkTopic = "Form1"
MaxButton =
0 'False
MinButton = 0 'False
ScaleHeight = 780
ScaleWidth =
5400
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin
VB.CommandButton cmdTidyVBCode
Caption
= "Tidy VB Code!"
Height = 375
Left = 4080
TabIndex =
1
Top = 180
Width = 1215
End
Begin
VB.Label lblMessage
Height = 495
Left = 60
TabIndex = 0
Top = 120
Width =
3915
End
End
Attribute VB_Name =
"frmTidyVBCode"
Attribute VB_GlobalNameSpace =
False
Attribute VB_Creatable = False
Attribute
VB_PredeclaredId = True
Attribute VB_Exposed =
False
Option Explicit
Public VBInstance As VBIDE.VBE
Public Connect As
Connect
Private Sub cmdTidyVBCode_Click()
On Error GoTo
cmdTidyVBCode_Click_Err
cmdTidyVBCode.Enabled = False
Select Case cmdTidyVBCode.Caption
Case "Tidy
VB Code!"
Dim lngLineIndex As
Long
Dim blnDeleteEmptyLineAfter As
Boolean
Dim blnDeleteEmptyLineBefore As
Boolean
Dim blnInsertEmptyLineAfter As
Boolean
Dim blnInsertEmptyLineBefore As
Boolean
Dim bytIndentIndex As
Long
Dim strPreviousLine As
String
Dim strCurrentLine As
String
Dim objVBProject As
VBIDE.VBProject
Dim
objVBComponent As VBIDE.VBComponent
Dim objCodeModule As VBIDE.CodeModule
For Each objVBProject In VBInstance.VBProjects
For Each objVBComponent In objVBProject.VBComponents
lblMessage.Caption = "Tidying VB Code for component "
& objVBComponent.Name & "..."
DoEvents
Select Case objVBComponent.Type
Case vbext_ComponentType.vbext_ct_RelatedDocument
'
Do nothing. Just skip
Case Else
bytIndentIndex = 0
Set
objCodeModule = objVBComponent.CodeModule
lngLineIndex = 1
Do While
lngLineIndex <= objCodeModule.CountOfLines
strCurrentLine =
RTrim$(LTrim$(objCodeModule.Lines(lngLineIndex, 1)))
Select Case True
Case UCase(strCurrentLine) Like "CASE *"
bytIndentIndex = bytIndentIndex - 1
blnDeleteEmptyLineBefore = True
Case UCase(strCurrentLine) Like "END SELECT*"
bytIndentIndex = bytIndentIndex - 1
blnDeleteEmptyLineBefore = True
Case UCase(strCurrentLine) Like "END WITH*"
bytIndentIndex = bytIndentIndex - 1
blnDeleteEmptyLineBefore = True
Case UCase(strCurrentLine) Like "WEND*"
bytIndentIndex = bytIndentIndex - 1
blnDeleteEmptyLineBefore = True
Case UCase(strCurrentLine) Like "LOOP*"
bytIndentIndex = bytIndentIndex - 1
blnDeleteEmptyLineBefore = True
Case UCase(strCurrentLine) Like "NEXT*"
bytIndentIndex = bytIndentIndex - 1
blnDeleteEmptyLineBefore = True
Case UCase(strCurrentLine) Like "ELSE*"
bytIndentIndex = bytIndentIndex - 1
blnDeleteEmptyLineBefore = True
Case UCase(strCurrentLine) Like "END IF*"
bytIndentIndex = bytIndentIndex - 1
blnDeleteEmptyLineBefore = True
Case UCase(strCurrentLine) Like "END SUB*"
bytIndentIndex = bytIndentIndex - 1
blnDeleteEmptyLineBefore = True
blnDeleteEmptyLineAfter = True
blnInsertEmptyLineAfter = True
Case UCase(strCurrentLine) Like "END FUNCTION*"
bytIndentIndex = bytIndentIndex - 1
blnDeleteEmptyLineBefore = True
blnDeleteEmptyLineAfter = True
blnInsertEmptyLineAfter = True
Case UCase(strCurrentLine) Like "END TYPE*"
bytIndentIndex = bytIndentIndex - 1
blnDeleteEmptyLineBefore = True
blnDeleteEmptyLineAfter = True
blnInsertEmptyLineAfter = True
Case UCase(strCurrentLine) Like "END ENUM*"
bytIndentIndex = bytIndentIndex - 1
blnDeleteEmptyLineBefore = True
blnDeleteEmptyLineAfter = True
blnInsertEmptyLineAfter = True
Case UCase(strCurrentLine) Like "END PROPERTY*"
bytIndentIndex = bytIndentIndex - 1
blnDeleteEmptyLineBefore = True
blnDeleteEmptyLineAfter = True
blnInsertEmptyLineAfter = True
End Select
If strCurrentLine = vbNullString
Or (Right$(strCurrentLine, 1) = ":" And
Left$(strCurrentLine, 1) <> "'" And Not
UCase(strCurrentLine) Like "ON ERROR GOTO *" And Not
UCase(strCurrentLine) Like "CASE *:") Then
objCodeModule.ReplaceLine lngLineIndex, strCurrentLine
Else
If
Mid$(strCurrentLine, 1, 1) = "'" Then
If Mid$(strCurrentLine, 2, 1) <> "'" Then
objCodeModule.ReplaceLine lngLineIndex, "'" &
Space$(IIf((bytIndentIndex * 4) - 1 > 0,
(bytIndentIndex * 4) - 1, 0)) &
LTrim$(Mid$(strCurrentLine, 2))
Else
objCodeModule.ReplaceLine lngLineIndex, strCurrentLine
End If
Else
objCodeModule.ReplaceLine lngLineIndex,
Space$(bytIndentIndex * 4) & strCurrentLine
End If
End If
Select Case True
Case UCase(strCurrentLine) Like "PRIVATE PROPERTY *" Or
UCase(strCurrentLine) Like "PUBLIC PROPERTY *" Or
UCase(strCurrentLine) Like "PROPERTY *"
bytIndentIndex = bytIndentIndex + 1
blnDeleteEmptyLineBefore = True
blnDeleteEmptyLineAfter = True
blnInsertEmptyLineBefore = True
Case UCase(strCurrentLine) Like "PRIVATE ENUM *" Or
UCase(strCurrentLine) Like "PUBLIC ENUM *" Or
UCase(strCurrentLine) Like "ENUM *"
bytIndentIndex = bytIndentIndex + 1
blnDeleteEmptyLineBefore = True
blnDeleteEmptyLineAfter = True
blnInsertEmptyLineBefore = True
Case UCase(strCurrentLine) Like "PRIVATE TYPE *" Or
UCase(strCurrentLine) Like "PUBLIC TYPE *" Or
UCase(strCurrentLine) Like "TYPE *"
bytIndentIndex = bytIndentIndex + 1
blnDeleteEmptyLineBefore = True
blnDeleteEmptyLineAfter = True
blnInsertEmptyLineBefore = True
Case UCase(strCurrentLine) Like "PRIVATE FUNCTION *" Or
UCase(strCurrentLine) Like "PUBLIC FUNCTION *" Or
UCase(strCurrentLine) Like "FUNCTION *"
bytIndentIndex = bytIndentIndex + 1
blnDeleteEmptyLineBefore = True
blnDeleteEmptyLineAfter = True
blnInsertEmptyLineBefore = True
Case UCase(strCurrentLine) Like "PRIVATE SUB *" Or
UCase(strCurrentLine) Like "PUBLIC SUB *" Or
UCase(strCurrentLine) Like "SUB *"
bytIndentIndex = bytIndentIndex + 1
blnDeleteEmptyLineBefore = True
blnDeleteEmptyLineAfter = True
blnInsertEmptyLineBefore = True
Case UCase(strCurrentLine) Like "IF* THEN *"
If Left$(LTrim$(Mid$(strCurrentLine,
InStrRev(UCase(strCurrentLine), "THEN ") + 5)), 1) = "'"
Then
bytIndentIndex =
bytIndentIndex + 1
End
If
blnDeleteEmptyLineAfter = True
Case UCase(strCurrentLine) Like "IF * THEN"
bytIndentIndex = bytIndentIndex + 1
blnDeleteEmptyLineAfter = True
Case UCase(strCurrentLine) Like "ELSE*"
bytIndentIndex = bytIndentIndex + 1
blnDeleteEmptyLineAfter = True
Case UCase(strCurrentLine) Like "* THEN"
strPreviousLine =
RTrim$(LTrim$(objCodeModule.Lines(lngLineIndex - 1,
1)))
If
Left$(strPreviousLine, 1) <> "'" And
Right$(strPreviousLine, 1) = "_" Then
bytIndentIndex = bytIndentIndex + 1
End If
blnDeleteEmptyLineAfter = True
Case UCase(strCurrentLine) Like "FOR *"
bytIndentIndex = bytIndentIndex + 1
blnDeleteEmptyLineAfter = True
Case UCase(strCurrentLine) = "DO" Or UCase(strCurrentLine)
Like "DO *"
bytIndentIndex = bytIndentIndex + 1
blnDeleteEmptyLineAfter = True
Case UCase(strCurrentLine) Like "WHILE *"
bytIndentIndex = bytIndentIndex + 1
blnDeleteEmptyLineAfter = True
Case UCase(strCurrentLine) Like "WITH *"
bytIndentIndex = bytIndentIndex + 1
blnDeleteEmptyLineAfter = True
Case UCase(strCurrentLine) Like "SELECT CASE *"
bytIndentIndex = bytIndentIndex + 1
blnDeleteEmptyLineAfter = True
Case UCase(strCurrentLine) Like "CASE *"
bytIndentIndex = bytIndentIndex + 1
blnDeleteEmptyLineAfter = True
End Select
If blnDeleteEmptyLineBefore
Then
Do While
lngLineIndex > 1
If RTrim$(objCodeModule.Lines(lngLineIndex - 1, 1)) =
vbNullString Then
objCodeModule.DeleteLines lngLineIndex - 1
lngLineIndex = lngLineIndex - 1
Else
Exit Do
End If
Loop
blnDeleteEmptyLineBefore = False
End If
If
blnDeleteEmptyLineAfter Then
Do While lngLineIndex < objCodeModule.CountOfLines
If RTrim$(objCodeModule.Lines(lngLineIndex + 1, 1)) =
vbNullString Then
objCodeModule.DeleteLines lngLineIndex + 1
Else
Exit Do
End If
Loop
blnDeleteEmptyLineAfter = False
End If
If
blnInsertEmptyLineBefore Then
If lngLineIndex > 1 Then
If RTrim$(objCodeModule.Lines(lngLineIndex - 1, 1))
<> vbNullString Then
objCodeModule.InsertLines lngLineIndex, ""
lngLineIndex = lngLineIndex + 1
End If
End If
blnInsertEmptyLineBefore = False
End If
If
blnInsertEmptyLineAfter Then
If lngLineIndex < objCodeModule.CountOfLines Then
If RTrim$(objCodeModule.Lines(lngLineIndex + 1, 1))
<> vbNullString Then
objCodeModule.InsertLines lngLineIndex + 1, ""
End If
End If
blnInsertEmptyLineAfter = False
End If
lngLineIndex =
lngLineIndex + 1
Loop
End Select
Next
Next
Set objCodeModule = Nothing
Set
objVBComponent = Nothing
Set objVBProject =
Nothing
lblMessage.Caption = "Tidy VB Code finished!!"
DoEvents
cmdTidyVBCode.Caption = "Close"
Case
"Close"
lblMessage.Caption = ""
cmdTidyVBCode.Caption = "Tidy VB Code!"
Connect.Hide
End Select
cmdTidyVBCode_Click_End:
cmdTidyVBCode.Enabled =
True
Exit Sub
cmdTidyVBCode_Click_Err:
MsgBox "Run-time error
" & Err.Number & ": " & Err.Description,
vbCritical, Err.Source
MsgBox "Processamento
abortado quando identava a linha " & lngLineIndex
& ";" & objCodeModule.CountOfLines & " do
componente " & objVBComponent.Name & vbCrLf &
"blnDeleteEmptyLineAfter=" & blnDeleteEmptyLineAfter
& ";blnDeleteEmptyLineBefore=" &
blnDeleteEmptyLineBefore & ";blnInsertEmptyLineAfter="
& blnInsertEmptyLineAfter &
";blnInsertEmptyLineBefore=" &
blnInsertEmptyLineBefore, vbInformation, Me.Caption
cmdTidyVBCode.Caption = "Close"
Resume
cmdTidyVBCode_Click_End
End Sub