View source for Code and Code Windows

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 

[[category:Access VBA & Jet SQL]]