Visual Basic
MS Access
RESUME
Personal Page
Home
Yahoo
Programmer's Heaven
VB World
Code Archive
Planet Source Code
VBNET
Code Hound
Other VB Sites
MS Access
RESUME
Personal Page
Home
Yahoo
Sample Code
If any of the Code works for you, please copy and Paste
VBExtra
Recipies
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