My_VB_Page

Visual Basic

Personal Page

Home

Programmer's Heaven

Code Archive

Planet Source Code

VBNET

Code Hound

Other VB Sites

Personal Page

Home

Sample Code

If any of the Code works for you, please copy and Paste

VBExtra



		Small Function from a module in a Vb 6.0 App =================================== =================================== Function CreateFoldero() '*************************************** 'creates a folder to store the application '*************************************** On Error GoTo CFD_err Dim fso, f Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.CreateFolder("C:\#####") ' Set the folder name here Form1.Show CFD_Exit: Exit Function CFD_err: Form1.Show End Function

			Function from a Module VB 6.0 App This function pulls data from a Database table and files a kist box with retreived data ========================== ========================== Public Function LoadListBoxes() '******************* 'This function was originalt writetn to fill 2 list boxes the 2nd list box is no longer needed 'so I commented out the unused lines 'Fill a List box on a form with 'data retrieved from text file in C:\My Documents '******************* Dim DT As String Dim emAddress As String Dim cname As String Dim cCode As String Dim locName As String Dim locCode As String Dim pName As String Dim pCode As String Dim db As Database Dim rs As Recordset Dim sql1 As String On Error GoTo LLB_err Set db = OpenDatabase("C:#######.mde") 'I used an Access .mde file place your database name here sql1 = "SELECT DISTINCTCsutomerInfo.ContractName, CustomerInfo.ContractID FROM CustomerInfo" Set rs = db.OpenRecordset(sql1) Form1.cmbContract.Clear 'clear comboBox ' Form1.cmbLocation.Clear Do Until rs.EOF ' cCode = rs(1) cname = rs(0) Form1.cmbContract.ColumnWidths = "100,25" Form1.cmbContract.AddItem cname rs.MoveNext Loop LLB_Exit: Exit Function LLB_err: Resume LLB_Exit End Function

		Function from a Module VB 6.0 App =========================== =========================== '********************************************************* 'Opens Outlook 'Creates an email wih a subject matter 'to be sent to a customer stored in a database 'If user has not opened OutLook the error handler will let the user know '********************************************************** Function CreateMail(astrRecip As String, _ strSubject As String, _ strMessage As String, _ Optional astrAttachments As String) As Boolean Dim olApp As Outlook.Application Dim objNewMail As Outlook.MailItem Dim blnResolveSuccess As Boolean On Error GoTo CreateMail_Err Set olApp = New Outlook.Application Set objNewMail = olApp.CreateItem(olMailItem) With objNewMail .Recipients.Add astrRecip .Subject = strSubject .Body = strMessage .Attachments.Add astrAttachments .Send End With CreateMail = True CreateMail_End: Exit Function CreateMail_Err: CreateMail = False If Err = -2113732605 Then 'control of an error if Outlook has not been opened MsgBox ("OPEN Outlook and try again. Thank You") Else MsgBox Err.Description End If Resume CreateMail_End End Function

	Function pulled from a Vb 6.0 App 'Helps in controlling an empty result set error 'In this code I used a Recipie database I am 'creating for my Wife ========================== ========================== '*************************************************************** 'Code to open a database connection 'Run a SQL statement and test for an empty table '*************************************************************** Option Explicit Public db As Database Public rs As Recordset Public sql1 As String Public Function DbOpen() sql1 = "select * from recipe" Set db = "c:\recipes.mdb", False, False, Connect) Set rs = db.OpenRecordset(sql1) 'If statement makes a count of records in a table to see if the table has Data If rs.EOF = False Then rs.MoveLast rs.MoveFirst If rs.RecordCount > 0 Then 'do nothing Else frmRecipe.Text1.Text = "No records found" End If End If End Function

Hosted by www.Geocities.ws