|
|||||||
|
|
|
|||||
|
|
|||||||
How to get only the file name?
'use as MsgBox OnlyFileName("c:\windows\win.com","\") 'gives you 'win.com' Function OnlyFileName(vPath$, vSlash$) As String Dim p% OnlyFileName = vPath For p% = Len(vPath$) To 0 Step -1 If Mid$(vPath$, p%, 1) = vSlash$ Then OnlyFileName = Mid$(vPath$, p% + 1, Len(vPath$) - p% + 1) Exit Function End If Next p% End Function
How to use free file number when reading or writing a file?
Private Sub GetFile(FileName$) Dim nFilenumber% Dim tmpLine$ Text1.Text = "" nFilenumber = FreeFile Open FileName$ For Input As #nFilenumber Do While Not EOF(nFileNumber) Input #nFileNumber, tmpLine Text1.Text = Text1.Text & tmpline Loop Close #nFileNumber End Sub
How to reboot the system from VB?
Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Boolean Public Const EWX_FORCE = 4 Public Const EWX_LOGOFF = 0 Public Const EWX_REBOOT = 2 Public Const EWX_SHUTDOWN = 1 ... Dim res As Boolean res = ExitWindowsEx (EWX_REBOOT, 0) If Not res Then MsgBox "Function failed" Else MsgBox "Shutting down Windows NOW!" End EndIf
How to repair Access database in VB?
Private Sub Command1_Click() On Error GoTo Repair_Error Dim MDB_Name As String CommonDialog1.Filter = "Access (*.mdb)|*.mdb" CommonDialog1.Flags = &H1000 CommonDialog1.FilterIndex = 1 CommonDialog1.Action = 1 If CommonDialog1.FileName <> "" Then Screen.MousePointer = 11 MDB_Name = CommonDialog1.FileName RepairDatabase (MDB_Name) Screen.MousePointer = 0 MsgBox "Database repaired successfully", 64, "Repair" End If Screen.MousePointer = 0 Exit Sub Repair_Error: MsgBox "Error when repairing database", 16, "Error" Screen.MousePointer = 0 Exit Sub End Sub
How to include an '&' on a Label?
Since an ampersand (&) on a label will indicate an access key
(with an underscore below to use with the Alt Key selection
combination), you may want to have an ampersand actually appear
as part of the text of the label.
To accomplish this, simply put two ampersands together like ... &&How to set Tab Stops in a ListBox?
Want to create a simple list box that shows several fields
of data? The columns property of the list box does not do
this, but you can use this function to do it. Public Const LB_SETTABSTOPS As Long = &H192 Public Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, lParam As Any) As Long Public Sub DoTabs(lstListBox As ListBox, TabArray() As Long) 'clear any existing tabs Call SendMessage(List1.hWnd, LB_SETTABSTOPS, 0&, ByVal 0&) 'set list tabstops Call SendMessage(List1.hWnd, LB_SETTABSTOPS, _ CLng(UBound(TabArray)) + 1, TabArray(0)) End SubFirst, set up the columns: Dim Tabs(2) as Long Tabs(0) = 0 Tabs(1) = 100 Tabs(2) = 200 DoTabs List1, Tabs Then, add your items: List1.AddItem "John" & vbTab & "Percival" & vbTab & _ "Content Editor" List1.AddItem "James" & vbTab & "Limm" & vbTab & _ "Senior Editor"
Tip by John Percival
How to use the IIf function?
Syntax IIf(expr, truepart, falsepart) The IIf function syntax has these named arguments: Part Description expr Required. Expression you want to evaluate. truepart Required. Value or expression returned if expr is True. falsepart Required. Value or expression returned if expr is False. Then you would use it as follows: MsgBox "Hello " & IIf(strName="John", _ "John", "some one else") & ". How are you?", vbOK This is a very mundane example, but you get the idea: it can save a
lot of code if you just want to evaluate something little. Did you
know that it is part of the VBA DLL? This means that if you are only
writing a small prgram that does not use anything else from the VBA
library then you could cut out this DLL. This is how:
Public Function IIf2(arg As Boolean, _ ret1 As Variant, ret2 As Variant) As Variant If arg Then IIf2 = ret1 Else IIf2 = ret2 End If End Function
Tip by John Percival
How to set the ToolTipText on a ListBox?
Private Sub List1_MouseMove(Button As _ Integer, Shift As Integer, X As Single, Y As Single) Dim YPos As Integer Dim iOldFontSize As Integer iOldFontSize = Me.Font.Size Me.Font.Size = List1.Font.Size YPos = Y \ Me.TextHeight("Xyz") + List1.TopIndex Me.Font.Size = iOldFontSize If YPos < List1.ListCount Then List1.ToolTipText = List1.List(YPos) Else List1.ToolTipText = "" End If End Sub
How to test for weekend?
If (WeekDay (Date) MOD 6 = 1) then Msgbox "It's the weekend!" End if
How to get rid of leading zeros in a string?
Function KillZeros(incoming as string) as string KillZeros = CStr(CInt(incoming)) End Function
How to reverse a string?
Function Code
Public Function reversestring(revstr As String) As String ' revstr: String to reverse ' Returns: The reverse string Dim doreverse As Long reversestring = "" For doreverse = Len(revstr) To 1 Step -1 reversestring = reversestring & Mid$(revstr, doreverse, 1) Next End Function Use
Dim strResult As String strResult = reversestring("String") MsgBox strResultHow to check Mousebutton?
If Button = 1 Then MsgBox "You have pressed the LEFT button" If Button = 2 Then MsgBox "You have pressed the RIGHT button" If Button = 3 Then MsgBox "You have pressed the LEFT and RIGHT button" If Button = 4 Then MsgBox "You have pressed the MIDDLE button"
How to delete the last character in a textbox?
Text1 = Left(Text1, Len(Text1) - 1)
How to rename a file?
Text1.Text = vb3.txt Text2.Text = vb4.txt Name Text1 As Text2
How to delete a directory?
Text1.Text = c:\delete\temp RmDir Text1
How to delete a file?
Text1.Text = c:\delete.txt Kill Text1
How to specify maximum lengths in a ComboBox?
Private Sub Combo1_KeyPress(KeyAscii As Integer) 'If the user is trying to type the eleventh key and... ' ...this key is not the Backspace Key, cancel the event! Const MAXLENGTH = 10 If Len(Combo1.Text) >= MAXLENGTH And KeyAscii <> vbKeyBack Then KeyAscii = 0 End Sub
How to select all text when a TextBox gets focus?
Public Sub TextSelected() Dim i As Integer Dim oMyTextBox As Object Set oMyTextBox = Screen.ActiveControl If TypeName(oMyTextBox) = "TextBox" Then i = Len(oMyTextBox.Text) oMyTextBox.SelStart = 0 oMyTextBox.SelLength = i End If End Sub Just add the function to your project and call it from the TextBox's GotFocus event. Private Sub Text1_GotFocus() TextSelected End Sub
How to allow ONLY numbers in a textbox?
If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0 End If Put the code above in the Keydown section of the text box.
How to highlight the contents of a text box?
Sub Highlight(txt as TextBox) txt.selStart = 0 txt.SelLength = Len(txt.Text) End Sub So you would put in a command button: txt.selStart = 0 txt.SelLength = Len(txt.Text) Or you can use the function: dim a call Highlight(text1) Where text1 is the text box.
How to find the number of characters in a text box?
Function CharCount(txt as TextBox) As Integer CharCount = Len(txt.text) End Function Example: Msgbox "Number of Caharcters is " & Len(text1.text) Where text1.text is the textbox. Or you can use the function: Dim a a = CharCount(text1.text) Msgbox a
How to copy one Listbox to another?
Sub ListCopy(SourceList As ListBox, DestList As ListBox) For x% = 0 to SourceList.ListCount - 1 DestList.Additem SourceList.List(x%) Next x% End Sub
How to get number of items in a Listbox?
Function ListNum(lst As ListBox) As Integer ListNum = lst.ListCount - 1 End Function
How to get string from Listbox?
Function ListString(lst As ListBox, indx As Integer) As String ListString = lst.list(indx) End Function
How to check for duplicates?
Function ListDups(lis As ListBox, check) As Boolean 'Return True if "check" is already in listbox and false if not Dim X As Integer For X = 0 To lis.ListCount - 1 If (check) = (lis.List(X)) Then ListDups = True Exit Function Else End If Next X ListDups = False End Function
How to load and save lists?
Sub LoadList(lst As ListBox, file As String) On Error GoTo error Open file For Input As #1 Do Until EOF(1) Input #1, a$ lst.AddItem a$ Loop Close 1 Exit Sub error: X = MsgBox("File Not Found", vbOKOnly, "Error!!") End Sub 'Example: Call LoadList(List1,"C:\WINDOWS\filename.ext") Sub SaveList(lst As ListBox, file As String) On Error GoTo error Open file For Output As #1 For i = 0 To lst.ListCount - 1 a$ = lst.List(i) Print #1, a$ Next Close 1 Exit Sub error: X = MsgBox("Error!!", vbOKOnly, "Error!!") End Sub
How to speed up database access?
Here is a trick to loop through a recordset faster. Often when looping through
a recordset people will use the following code:
Do While Not Records.EOF Combo1.AddItem Records![Full Name] Eecords.Movenext Loop The problem is that everytime the database moves to the next record it must
make a check to see if it has reached the end of the file. This slows the
looping down a great deal. When moving or searching throuch a large record
set this can make a major difference. Here is a better way to do it. Records.MoveLast intRecCount=Records.RecordCount Records.MoveFirst For intCounter=1 To intRecCount Combo1.AddItem Records![Full Name] Records.MoveNext Next intCounter You should see about a 33% speed increase. Tip by Levi PageHow to Create Rainbow Text?
1. Start a new Standard Exe project; form1 is created by default 2. Type in the following code. Sub Form_Paint() Dim I As Integer, X As Integer, Y As Integer Dim C As String Cls For I = 0 To 91 X = CurrentX Y = CurrentY C = Chr(I) 'Line -(X + TextWidth(C), Y = TextHeight(C)), _ QBColor(Rnd * 16), BF CurrentX = X CurrentY = Y ForeColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256) Print "Hello World Hello World Hello World Hello" Next End Sub 3. Run the program by pressing F5 or choosing start from the run program and watch the form fill with lots of multi-coloured text Tip by Steve Anderson
How to Add frequently used modules to the templates directory?
If you have modules or class modules that you use all the time in many of your
projects, you can add them to the Templates directory. It is usually
located in the VB directory (often C:\Program Files\DevStudio\VB) and is
called Template. Under the Template directory you will find several
directories that correspond to the types of files you can add, such as
Classes. Just copy your source code files to the appropriate directory and
go try to add the file to the project. Your files will appear under the New Tab.
Tip by James LimmHow to retrieve the screen resolution?
It is often very useful to be able to resize your Visual Basic program
depending on what the screen resolution is. In this tip, we will explain
how to find the resolution.
ResWidth = Screen.Width \ Screen.TwipsPerPixelX ResHeight = Screen.Height \ Screen.TwipsPerPixelY ScreenRes = ResWidth & "x" & ResHeight ResWidth will be set to the resolution of the width on the screen, and
ResHeight will be set to the resolution of the height of the screen.
ScreenRes will be set to something similar to: 800x600 Tip by James LimmHow to make a form fade to black?
Sub FormFade(frm As Form) ' Makes Form Fade To Black ' Example: FormFade(Form1) For icolVal% = 255 To 0 Step -1 DoEvents frm.BackColor = RGB(icolVal%, icolVal%, icolVal%) Next icolVal% End Sub
How to scroll caption on the form's title bar?
Sub TitleScroll(frm As Form) Dim X As Integer Dim current As Variant Dim Y As String Y = frm.Caption frm.Caption = "" frm.Show For X = 0 To Len(Y) If X = 0 Then frm.Caption = "" current = Timer Do While Timer - current < 0.1 DoEvents Loop GoTo done Else: End If frm.Caption = left(Y, X) current = Timer Do While Timer - current < 0.05 DoEvents Loop done: Next X End Sub
How to hide mouse cursor?
You can use the API function Showcursor to control the visibility of the
mouse cursor. To use this tip, paste this declaration into a module.
The Parameter lShow show be set to True (non-zero) to display the
cursor, False to hide it.
Public Declare Function ShowCursor& Lib "user32" (ByVal lShow As Long)How to check if the credit card is valid?
Add this function to a .BAS or a form and to check whether a creditcard number is valid, call it using something like: Valid = IsValidCreditCardNumber("4552012301230123") . Valid will then contain true or false depending on what number was passed to the function.
Public Function IsValidCreditCardNumber(ByVal pCardNumber As String) As Boolean Dim CharPos As Integer Dim CheckSum As Integer Dim tChar As String For CharPos = Len(pCardNumber) To 2 Step -2 CheckSum = CheckSum + CInt(Mid(pCardNumber, CharPos, 1)) tChar = CStr((Mid(pCardNumber, CharPos - 1, 1)) * 2) CheckSum = CheckSum + CInt(Left(tChar, 1)) If Len(tChar) > 1 Then CheckSum = CheckSum + CInt(Right(tChar, 1)) Next If Len(pCardNumber) Mod 2 = 1 Then CheckSum = CheckSum + CInt(Left(pCardNumber, 1)) If CheckSum Mod 10 = 0 Then IsValidCreditCardNumber = True Else IsValidCreditCardNumber = False End If End FunctionHow to check what the last day of a month is?
Public Function LastDayOfMonth(ByVal ValidDate As Date) As Byte Dim LastDay As Byte LastDay = DatePart("d", DateAdd("d", -1, DateAdd("m", 1, _ DateAdd("d", -DatePart("d", ValidDate) + 1, Date)))) LastDayOfMonth = LastDay End Function Private Sub Command1_Click() MsgBox "The last day of the month with date " & Date & _ " is " & LastDayOfMonth(Date) End Sub
How to open VB 6 file with VB 5?
You need first use notepad to open the VB 6 .vbp file. In VB 6 .vbp
file, find 'Retained = 0' statement, delete it, and save the file.
Now you can open VB 6 file without error message.How to deal with Null strings in Access database fields?
By default Access string fields contain NULL values unless a string value
(including a blank string like "") has been assigned. When you read these
fields using recordsets into VB string variables, you get a runtime type-
mismatch error. The best way to deal with this problem is to use the built-
in & operator to concatenate a blank string to each field as you read it.
For example: