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