VB Snippets- Visual Basic Explorer

Free Web Hosting Provider - Web Hosting - E-commerce - High Speed Internet - Free Web Page

VB Snippets- Visual Basic Explorer Sniplets

'----------------------------------

'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 "\")