Login or Sign Up to become a member!

Less Than Dot is a community of passionate IT professionals and enthusiasts dedicated to sharing technical knowledge, experience, and assistance. Inside you will find reference materials, interesting technical discussions, and expert tips and commentary. Once you register for an account you will have immediate access to the forums and all past articles and commentaries.

From Wiki

Please be aware that some anti-virus programmes may not like tampering with code windows. These examples are just that, examples.

Here are a few examples of fun things to do with the Visual Basic Editor (VBE).

Example: Hide the code window

   Sub HideCodeWindow()

       'Hide VBE window to prevent screen flashing
       VBE.MainWindow.Visible = False

   End Sub    

If you have a large number of code windows open, it can cause an "Out of memory" error, so it is generally a good idea to close the code windows.

Example: Close all code windows

   Sub CloseAllCodeWindows()
       '"When removing items from an indexed collection always iterate backwards."
       'Window #1 is the current window.
       Dim i
   
       For i = VBE.CodePanes.Count To 1 Step -1
           VBE.CodePanes(i).Window.Close
       Next
   End Sub    

You can output the code from all components of your project using VBE.

Example: Output all code to desktop

   Sub AllCodeToDesktop()
       'The reference for the FileSystemObject Object is Windows Script Host Object Model
       'but it not necessary to add the reference for this procedure.
        
       Dim fs As Object
       Dim f As Object
       Dim strMod As String
       Dim mdl As Object
       Dim i As Integer
        
       Set fs = CreateObject("Scripting.FileSystemObject")
       
       'Set up the file.
       Set f = fs.CreateTextFile(SpFolder(Desktop) & "\" _
           & Replace(CurrentProject.Name, ".", "") & ".txt")
       
       'For each component in the project ...
       For Each mdl In VBE.ActiveVBProject.VBComponents
           'using the count of lines ...
           i = VBE.ActiveVBProject.VBComponents(mdl.Name).CodeModule.CountOfLines
           'put the code in a string ...
           If i > 0 Then
              strMod = VBE.ActiveVBProject.VBComponents(mdl.Name).codemodule.Lines(1, i)
           End If
           'and then write it to a file, first marking the start with
           'some equal signs and the component name.
           f.writeline String(15, "=") & vbCrLf & mdl.Name _
               & vbCrLf & String(15, "=") & vbCrLf & strMod
       Next
       
       'Close eveything
       f.Close
       Set fs = Nothing
   End Sub

To get special folders, you can use the list supplied by Microsoft.

Enumerating Special Folders: http://www.microsoft.com/technet/scriptcenter/guide/sas_fil_higv.mspx?mfr=true

   Option Explicit
   
   Const Desktop = &H10&
   Const MyDocuments = &H5&
   
   Function SpFolder(SpName)
    
       Set objShell = CreateObject("Shell.Application")
       Set objFolder = objShell.Namespace(SpName)
    
       Set objFolderItem = objFolder.Self
    
       SpFolder = objFolderItem.Path
       
   End Function

If you are lazy in a peculiar way, you can use VBE to add code.

Example: Add some lines required for DAO

   Sub AddDAO(ProcName As String)
       Dim oVBE As Object
       Dim mdl As Object
       Dim blnFound As Boolean
       Dim lngLine As Long
       Dim strMdlName As String
       Dim strDAO As String

       'To make life easier and lines shorter.
       Set oVBE = VBE.ActiveVBProject.VBComponents

       'The code to be inserted.
       strDAO = "'Requires Microsoft DAO 3.x Object Library" & vbCrLf _
       & vbTab & "Dim db As DAO.Database" & vbCrLf _
       & vbTab & "Dim rs as DAO.Recordset" & vbCrLf & vbCrLf _
       & vbTab & "Set db = CurrentDB" & vbCrLf _
       & vbTab & "Set rs = db.Openrecordset("""")" & vbCrLf

       'Check each module ...
       For Each mdl In oVBE
           'for the required procedure ...
           blnFound = oVBE(mdl.Name).CodeModule.Find("AddDAOToThisSub", 1, 1, 60, 1)
           'if it is found. ...
           If blnFound = True Then
               'make sure there is a reference to DAO ...
               If RefExists("DAO") = False Then
                   ReferenceFromFile "C:\Program Files\Common Files\Microsoft Shared\DAO\dao360.dll"
               End If
               'get the line number ...
               lngLine = oVBE(mdl.Name).CodeModule.ProcStartLine(ProcName, vbext_pk_Proc)
               'and insert the code.
               oVBE(mdl.Name).CodeModule.InsertLines (lngLine + 2), strDAO
           End If
       Next
   End Sub
   
   Function RefExists(RefName)
   Dim ref As Object
    
   RefExists = False
    
   For Each ref In References
       If ref.Name = RefName Then
           RefExists = True
       End If
   Next
    
   End Function
    
   Function ReferenceFromFile(strFileName As String) As Boolean
   Dim ref As Reference
    
       On Error GoTo Error_ReferenceFromFile
       References.AddFromFile (strFileName)
       ReferenceFromFile = True
    
   Exit_ReferenceFromFile:
       Exit Function

   Error_ReferenceFromFile:
       ReferenceFromFile = False
       Resume Exit_ReferenceFromFile
   End Function  

Further Information http://msdn2.microsoft.com/en-us/library/aa220212(office.10).aspx