Snippets

Here you'll find a collection of useful snippets. What the heck are snippets you ask? Snippets are tiny bits of code that show how to do something, usually only a few lines long. Plus, it gives me a place to drop everything else that I can't figure out where to put ;-).

'----------------------------------
'Joshua M. Curtis-This will import
'name or whatever into a combo drop
'down from an existing file. Each
'line is an entry. 
'http://www.CurtisOnline.net
'----------------------------------
Open "compnames.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, lne$
combo1.AddItem lne$
Loop
Close #1

'----------------------------------
'Joshua M. Curtis-This should open
'file into any text box -fast.
'http://www.CurtisOnline.net
'----------------------------------
Dim FileLength
Open "yourfile.txt" For Input As #1
FileLength = LOF(1)
var1 = Input(FileLength, #1)
Text1.Text = var1
Close #1

'----------------------------------
'Burt Abreu -One way to time a loop 
'if you don't need millisecond resolution 
'----------------------------------
Dim BeginTime As Date
Dim FinishTime As Date
Dim ElapsedTime As Long

BeginTime = Now   'get the beginning time

Do
'Your loop code...
Loop

FinishTime = Now  'get the time after you exit the loop

ElapsedTime = DateDiff("s", BeginTime, FinishTime)     'figure how many seconds between them

'Display like this or with debug
lblStart.Caption = BeginTime
lblFinish.Caption = FinishTime
lblElapsed.Caption = "Elapsed time in seconds " & ElapsedTime

End Sub

'-----------------------------------
'Dale Botwin -How to have a text box 
'highlight upon selection so that the
'next user input key begins a new entry, 
'clearing the entire previous entry.
'-----------------------------------
'In the mytextbox gotfocus event:
mytextbox.sellength = len(mytextbox.text) which can also be written
                        = len(mytextbox)
since .text is the default property of a text box.

'-----------------------------------
'Burt Abreu [from VISBAS-L archive]
'Open an URL using default browser
'-----------------------------------
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal
hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal
lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long)
As Long

X = ShellExecute(MDIForm1.hwnd, "Open", "http://www.VBExplorer.com",
0&, 0&, 0&)

'-----------------------------------
'Burt Abreu 
'Make a textbox scroll to the bottom
'-----------------------------------
Text1.SelStart = Len(Text1.Text)

'-----------------------------------
'Drew Burchett   [dirtdart@apex.net] 
'A generic sub that can be used to 
'clear all textboxes on a form w/o 
'setting them individually.
'-----------------------------------
Public Sub ClearAllText(frm As Form, ctl As Control)

For Each ctl In frm
        If TypeOf ctl Is TextBox Then
                ctl.Text=""
        End If
Next ctl
End Sub

'-----------------------------------
'John Baumbach [jbaumbach@kw.edu] 
'A similar sub that will clear any 
'control with a text property or a 
'list-index property on the form.
'-----------------------------------
Public Sub ClearAllControls(frmForm As Form)
Dim ctlControl As Object
    On Error Resume Next
    For Each ctlControl In frmForm.Controls
        ctlControl.Text = ""
        ctlControl.ListIndex = -1
        DoEvents
    Next ctlControl
End Sub

Just call this procedure from your code like this:

Call ClearAllControls(Me)

'-----------------------------------
'Tim Jones  aquatech@netcon.net.au 
'Check if file exists (this code
'improves on previous code posted 
'which didn't trap error if file 
'didn't exist.)
'-----------------------------------
Public Function FileExists(ByVal sFileName As String) As Boolean

    Dim sFile As String

    On Error Resume Next

    FileExists = False

    sFile = Dir$(sFileName)
    If (Len(sFile) > 0) And (Err = 0) Then
        FileExists = True
    End If

End Function

'-----------------------------------
'Tim Jones  aquatech@netcon.net.au 
'Check if directory exists 
'-----------------------------------
Public Function DirExists(ByVal sDirName As String) As Boolean

    Dim sDir As String

    On Error Resume Next

    DirExists = False

    sDir = Dir$(sDirName, vbDirectory)
    If (Len(sDir) > 0) And (Err = 0) Then
        DirExists = True
    End If

End Function


'-----------------------------------
'Tim Jones  aquatech@netcon.net.au 
'Can be used with FileExists snippet
'to kill a selected file.
'-----------------------------------
Public Sub FileKill(ByVal sFileName As String)

    On Error Resume Next
    
    If FileExists(sFileName) Then
    Kill sFileName
    End If

End Function

'-----------------------------------
'Francis J. Loh  Francis.Loh@unisys.com
'Instead of writing a Pause function with 
'the timer, just use the API...
'-----------------------------------
'It should be clear that the Sleep API function 
'freezes your app for the milliseconds specified
'completely. MS KB Article ID Q158175 
'has more information about this. 
'Basically, if you want to pause to allow your 
'application to finish a process in it's thread
'use a timer loop with doevents. If you're trying 
'to wait for an external process to end or just 
'simply wait use Sleep.  


Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

And call it like so...

Sleep (3000)  '// Will pause for 3 seconds

'-----------------------------------
'Francis J. Loh  Francis.Loh@unisys.com
'instead of coding a function to make sure 
'a path exists use the API...
'-----------------------------------
Declare Function MakeSureDirPathExists Lib "IMAGEHLP.DLL" (ByVal DirPath As String) As Long

And call it like such...

lRetVal = MakeSureDirPathExists("D:\SomeFolder\AnotherFolder\YetAnotherFolder\")

(Be sure the string ends with a "\")