Login or Sign Up to become a member!
LessThanDot Site Logo


Community Wiki

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.

LTD Social Sitings

Lessthandot twitter Lessthandot Linkedin Lessthandot facebook Lessthandot rss

Note: Watch for social icons on posts by your favorite authors to follow their postings on these and other social sites.


Google Ads

Code and Code Windows

From Wiki

Revision as of 21:24, 2 November 2009 by Remou (Talk | contribs)

(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to: navigation, search

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
   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
       'Close eveything
       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
   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
   End Function
   Function ReferenceFromFile(strFileName As String) As Boolean
   Dim ref As Reference
       On Error GoTo Error_ReferenceFromFile
       References.AddFromFile (strFileName)
       ReferenceFromFile = True
       Exit Function

       ReferenceFromFile = False
       Resume Exit_ReferenceFromFile
   End Function  

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

94 Rating: 2.8/5 (70 votes cast)