• Create system DSN to MS SQLServer database programmatically, using VB code

• Accessing system Drives and their properties using Visual Bassic File System Objects (FSO)

• How to prevent adding duplicate entries to a combo box or list box when you are programatically building the list

• How do i use the Visual Basic Common Dialog control

• programmatically creating system DSN to MS access database using VB code

• Pass two different sql queries simultaneously to a single VB recordset.
  How do I use NextRecordset method of the VB recordset ?

• Get a list of all the DSNs and their Drivers using VB code

Create a system DSN to MS SQLServer database using VB code

The example uses SQLConfigDataSource windows API function. This is very easy compared to manipulating windows registry to create a DSN.

'Add a command button to your form
'Paste the following code into the form code window
'Replace the string values such asservername,database etc to suit yours
'start of declarations section

	Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" _
	   (ByVal hwndParent As Long, ByVal fRequest As Long, _
	   ByVal lpszDriver As String, ByVal lpszAttributes As String) _
	   As Long
	
	Private Const lnghwndParent = 0&
	Private Const ODBC_ADD_SYS_DSN = 4
	Private x As Long
'End of declarations section

Private Sub Command1_Click()
On Error GoTo errorhandler
    Dim strAttributes As String
    Dim DSNName As String
    Dim strDriver As String
    Dim strServerName  As String
    Dim strDatabase As String
    Dim blnResult As Boolean
    
'Replace the next four string values to suit yours    
    DSNName = "Quotemonitor"
    strDriver = "SQL Server"
    strServerName = "IC6"
    strDatabase = "Northwind"
    
    strAttributes = "DSN=" & DSNName & Chr(0)
    strAttributes = strAttributes & "Server=" & strServerName & Chr(0)
    strAttributes = strAttributes & "Database=" & strDatabase & Chr(0)
    strAttributes = strAttributes & "Trusted_Connection=Yes" & Chr(0) & Chr(0)

    blnResult = SQLConfigDataSource(lnghwndParent, ODBC_ADD_SYS_DSN, strDriver, strAttributes)
    
    If blnResult Then
        MsgBox "done"
    Else
        MsgBox Err.Number & "--" & Err.Description & "--" & Err.Source
    End If
    
Exit Sub

errorhandler:
MsgBox Err.Number & "--" & Err.Description & "--" & Err.Source
End Sub

For more information, please refer to ODBC Programmer's Reference at MSDN Library

Top

Accessing system Drives and their properties using Visual Bassic File System Objects (FSO)

'Add a Command button to your Form
'Paste the following in to the code window of your form

Private Sub Command1_Click()
	MsgBox AboutDrive()
End Sub

Function AboutDrive()
	Screen.MousePointer = vbHourglass
	
	Dim strTemp As String
	Dim strReturn As String
	Dim fso As FileSystemObject
	Dim myDrive As Drive
	Dim myDrives As Drives
	
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set myDrives = fso.Drives
	
	For Each myDrive In myDrives
	If myDrive.IsReady Then
	
	strReturn = strReturn & " DriveLetter: " & myDrive.DriveLetter & "-"
	strReturn = strReturn & " Volume name: " & myDrive.VolumeName & "-"
	
	Select Case myDrive.DriveType
	Case 0: strTemp = "Unknown"
	Case 1: strTemp = "Removable"
	Case 2: strTemp = "Fixed"
	Case 3: strTemp = "Network"
	Case 4: strTemp = "CD-ROM"
	Case 5: strTemp = "RAM Disk"
	End Select
	
	strReturn = strReturn & " Drive Type: " & strTemp & "-"
	
	strReturn = strReturn & " Total Size: " & FormatNumber(myDrive.TotalSize / 1024, 0) & " Kbytes" & "-"
	
	strReturn = strReturn & " Free Space: " & FormatNumber(myDrive.FreeSpace / 1024, 0) & " Kbytes" & "-"
	
	If myDrive.IsReady Then
	strTemp = "Drive is Ready."
	Else
	strTemp = "Drive is not Ready."
	End If
	
	strReturn = strReturn & " Drive Status: " & strTemp & "-"
	strReturn = strReturn & " File System: " & myDrive.FileSystem & "-"
	strReturn = strReturn & " Serial Number: " & myDrive.SerialNumber & "-"
	strReturn = strReturn & " Share Name: " & myDrive.ShareName & vbCrLf
	End If
	Next myDrive
	
	Screen.MousePointer = vbNormal
	AboutDrive = strReturn
	
 End Function

Top

How to prevent adding duplicate entries to a combo box or list box when you are programatically building the list.

For eg. you have a vb Recordset and you are looping through it adding values of a field to the Combo box or list box and you are not sure if you have distinct values in the field.

'Add a command button and a combo box to the form
'Paste the following code in to the form code window
'reference Microsoft ActiveX Data Objects 2.6 Library
'chage the connection string and SQL query to suit yours

 Private Sub Command1_Click()
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim strSql As String
    Dim strTemp As String
    Dim blnflag As Boolean
    
    strSql = "SELECT IngredientName FROM Ingredient_tbl;"
    conn.Open "dsn=db1"
    rs.Open strSql, conn
    blnflag = False
    
    Do While Not rs.EOF
        If Not (IsNull(rs!IngredientName)) Then strTemp = rs!IngredientName
        For x = 0 To Combo1.ListCount - 1
            If Combo1.List(x) = strTemp Then
                blnflag = True  'If already exists then exit for loop
                Exit For
            Else
                blnflag = False
            End If
        Next x
        
        If blnflag = False Then   ' if doesn't exist in the combo, then add to the Combo box
            Combo1.AddItem strTemp
        End If
    rs.MoveNext
    Loop
    
    MsgBox "done"
 End Sub

Top

How do i use the Visual Basic Common Dialog control to display windows File Open dialog box

'Add a command button and a Textbox to your form
'Add  the Component 'Microsoft Common Dialog Control' from Project-->Components to the project and.......
'....add it to the form
'Paste the following code into the form code window
 Private Sub Command1_Click()
'commom dialog
With CommonDialog1
        .CancelError = False
        '.DefaultExt = ".jpg"
        .DialogTitle = "Select the File you want..."
        .Filter = "All files (*.*)|*.*|Image files (*.JPG)|*.JPG"
        .InitDir = "C:\"
        .ShowOpen
End With
    Text1.Text = CommonDialog1.FileName
 End Sub

Top

Create a system DSN to MS access database using VB code

The example uses SQLConfigDataSource windows API function. This is very easy compared to manipulating windows registry to create a DSN programmatically.

'Add a command button to your form
'Paste the following code into the form code window
'Replace "C:\db1.mdb" to suit yours
'start of declarations section

Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" _
   (ByVal hwndParent As Long, ByVal fRequest As Long, _
   ByVal lpszDriver As String, ByVal lpszAttributes As String) _
   As Long

Private Const lnghwndParent = 0&
Private Const ODBC_ADD_SYS_DSN = 4
Private x As Long
'End of declarations section

Private Sub Command1_Click()
On Error GoTo errorhandler
    Dim strAttributes As String
    Dim DatabaseFullPath As String
    Dim DSNName As String
    Dim strDriver As String
    Dim blnResult As Boolean
   
    DatabaseFullPath = "C:\db1.mdb"
    DSNName = "testDSN"
    strDriver = "Microsoft Access Driver (*.mdb)"

    If Dir(DatabaseFullPath) = "" Then
        MsgBox "file cannot be found"
        Exit Sub
    End If
    
    strAttributes = "DSN=" & DSNName & Chr(0)
    strAttributes = strAttributes & "DBQ=" & DatabaseFullPath & Chr(0) & Chr(0)
    blnResult = SQLConfigDataSource(lnghwndParent, ODBC_ADD_SYS_DSN, strDriver, strAttributes)
   
    If blnResult Then
        MsgBox "done"
    Else
        MsgBox Err.Number & "--" & Err.Description & "--" & Err.Source
    End If
    
Exit Sub
errorhandler:
MsgBox Err.Number & "--" & Err.Description & "--" & Err.Source
End Sub

Top

How do I pass two different sql queries simultaneously to the same VB recordset ?
How do I use NextRecordset method of the VB recordset ?

'Add a command button and twwo combo boxes to the form
'Paste the following code in to the form code window
'reference Microsoft ActiveX Data Objects 2.6 Library
'chage the connection string to suit yours(It is pointing to the Sqlserver Northwind Databse)

Private Sub Command1_Click()
    Dim conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim str1stQry As String
    Dim str2ndQry As String
    
    Set rs = New ADODB.Recordset
    Set conn = New ADODB.Connection
  
    str1stQry = "SELECT CategoryName FROM Categories"
    str2ndQry = "SELECT  RegionDescription FROM Region"
 	
    'The connection is pointing to the Sqlserver Northwind Databse
    conn.Open "DSN=Northwind"
    rs.Open str1stQry & ";" & str2ndQry, conn, adOpenForwardOnly, adLockReadOnly
    
    'process the 1st set of records
    Do While Not rs.EOF
          Combo1.AddItem rs.Fields(0)
          rs.MoveNext
    Loop
    
    'Now, process the 2nd set of records
    Set rs = rs.NextRecordset
    Do While Not rs.EOF
          Combo2.AddItem rs.Fields(0)
          rs.MoveNext
    Loop
    
    rs.Close
    Set rs = Nothing
    conn.Close
    Set conn = Nothing
    
    MsgBox "done"
End Sub

Top

Get a list of all the User DSNs System DSNs and their Drivers using VB code

'Add Command button to your form
'Add a list box to your form and make it a bit wider so you can see long text
'Paste the following code into the Form code window

Private Declare Function SQLDataSources Lib "ODBC32.DLL" _
(ByVal henv&, ByVal fDirection%, ByVal szDSN$, ByVal cbDSNMax%, pcbDSN%, _
ByVal szDescription$, ByVal cbDescriptionMax%, pcbDescription%) As Integer
Private Declare Function SQLAllocEnv% Lib "ODBC32.DLL" (env&)
Const SQL_FETCH_NEXT As Long = 1

Private Sub Command1_Click()
    Dim i As Integer
    Dim strDSN As String * 1024
    Dim stDRV As String * 1024
    Dim strTemp1 As String
    Dim strTemp2 As String
    Dim intDSN As Integer
    Dim intDRV As Integer
    Dim lngHenv As Long

    On Error Resume Next
    List1.Clear

    If SQLAllocEnv(lngHenv) <> -1 Then
        Do Until i <> 0
            strDSN = Space$(1024)
            i = SQLDataSources(lngHenv, SQL_FETCH_NEXT, strDSN, 1024, intDSN, stDRV, 1024, intDRV)
            strTemp1 = Left$(strDSN, intDSN)
            strTemp2 = Left$(stDRV, intDRV)
            If strTemp1 <> Space(intDSN) Then
                List1.AddItem strTemp1 & "   -->   " & strTemp2
            End If
        Loop
    End If
End Sub

Top