Visual Basic Source codes
Google
Web www.mahipalreddy.com

 

Browsing for a Folder using Visual Basic Code (Uses Windows API)

'Code by Mahipal Padigela
'Add a Command button to your Form
'Paste the following in to the code window of your form
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260

Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
(ByVal lpString1 As String, ByVal lpString2 As String) As Long

Private Type BrowseInfo
   hWndOwner As Long
   pIDLRoot As Long
   pszDisplayName As Long
   lpszTitle As Long
   ulFlags As Long
   lpfnCallback As Long
   lParam As Long
   iImage As Long
End Type

Private Sub Command1_Click()
    Dim lngpIDList As Long
    Dim strBuffer As String
    Dim typeBrowseInfo As BrowseInfo
       
    typeBrowseInfo.hWndOwner = Me.hWnd
    typeBrowseInfo.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
    lngpIDList = SHBrowseForFolder(typeBrowseInfo)
    If (lngpIDList) Then
       strBuffer = Space(MAX_PATH)
       SHGetPathFromIDList lngpIDList, strBuffer
       strBuffer = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
       txtPath.Text = strBuffer
    End If
End Sub

Top

Getting the List of Tables from a Microsoft Access Database

'Code by Mahipal Padigela
'Add a Command button and a List Box to your form
'Add a reference to 'Microsoft Access 9.0 Object Library'
'Replace 'C:\Mahipal.mdb' with the path of your Access Database file
'Paste the following code in to your Form code window

Private Sub Command1_Click()
    Dim i As Integer
    Dim AppNew As Object

    Set AppNew = New Access.Application
    AppNew.OpenCurrentDatabase ("C:\Mahipal.mdb")
    List1.Clear
    i = 0
    For i = 0 To AppNew.CurrentDb.TableDefs.Count - 1
        If Not (AppNew.CurrentDb.TableDefs(i).Name Like "MSys*") Then
             List1.AddItem AppNew.CurrentDb.TableDefs(i).Name
        End If
    Next i

    AppNew.CurrentDb.Close
    Set AppNew = Nothing
End Sub

Top

Getting a List of Fields and their Datatypes from a Microsoft Access Table

'Code by Mahipal Padigela
'Add a Command button and 2 List Boxes to your form
'Add a reference to 'Microsoft Access 9.0 Object Library'
'Replace "C:\Mahipal.mdb" with the path of your Access Database file
'Replace "Table1" with the Name of your database Table
'Paste the following code in to your Form code window 

Private Sub Command1_Click()
    Dim i As Integer
    Dim AppNew As Object
    Set AppNew = New Access.Application
    
    AppNew.OpenCurrentDatabase ("C:\Mahipal.mdb")
    List1.Clear
    i = 0
    For i = 0 To AppNew.CurrentDb.TableDefs("Table1").Fields.Count - 1
         List1.AddItem AppNew.CurrentDb.TableDefs("Table1").Fields(i).Name
         List2.AddItem AppNew.CurrentDb.TableDefs("Table1").Fields(i).Type
    Next i
    
    AppNew.CurrentDb.Close
    Set AppNew = Nothing

'Type "10" is a Text field
'Type "12" is a Memo Field
'Type "4"  is a Number Field
'Type "5"  is a Auto Number Field
'Type "1"  is a Yes/No Field
'Type "8"  is a Date type

End Sub

Top

Copy/Move Data from a VB Recordset to Excel Worksheet

'Code by Mahipal Padigela
'Add a Command button to your Form
'Add a reference to 'Microsoft Excel 9.0 Object Library'
'Add a reference to 'Microsoft ActiveX data Objects 2.6 Object Library'
'Replace "C:\Mahipal.mdb" with the path of your Microsoft Access Database File
'Paste the following code in to your Form code window
Private Sub Command1_Click()
Form1.MousePointer = vbHourglass
Dim ApExcel As Object, RS As ADODB.Recordset, CONN As ADODB.Connection, strSql As String 
Dim i As Integer
strSql = "Select * from Company"
Set CONN = New ADODB.Connection
Set RS = New ADODB.Recordset
CONN.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Mahipal.mdb;Persist Security Info=False"
RS.Open strSql, CONN

Set ApExcel = New Excel.Application
ApExcel.Workbooks.Add
ApExcel.Caption = "Test Data Export from VB Recordset"

i = 0
For i = 0 To RS.Fields.Count - 1
  ApExcel.Worksheets(1).Cells(1, i + 1).Value = RS.Fields(i).Name
Next i
ApExcel.Worksheets(1).Rows("1:1").Font.Bold = True

ApExcel.Worksheets(1).Range("A2").CopyFromRecordset RS
ApExcel.Visible = True

Set ApExcel = Nothing
RS.Close
Set RS = Nothing
CONN.Close
Set CONN = Nothing
Form1.MousePointer = vbNormal
End Sub

Top

Getting Currently logged in User's ID from Visual Basic code

'Code by Mahipal Padigela
'Add a Command button to your Form
'Paste the following code in to your Form code window
Private Sub Command1_Click()
  Dim objWscript
  Dim strUser
  Set objWscript = CreateObject("WSCRIPT.Network")
  strUser = objWscript.UserName  
  MsgBox "Logged In User is: " & strUser
End Sub

Top

Printing/Exporting Excel files to PDF(Acrobat) files using Visual Basic code

'Code by Mahipal Padigela
'Add a Command button to your Form
'Add a reference to 'Microsoft Excel 9.0 Object Library'
'Add a reference to ACROBAT DISTILLER OBJECT LIBRARY(you must have Acrobat distiller 
'software on your machine)
'Paste the following code in to your Form code window
Private Sub Command1_Click()
    Dim msExcel As Object
    Dim myPDF As Object
    Dim ADist As String   'to hold the acrobat distiller name
    Dim strPSpath As String
    Dim strPDFpath As String
    
    Set msExcel = CreateObject("Excel.application")
    msExcel.Visible = False
    Set myPDF = New PdfDistiller
    ADist = "Acrobat Distiller on Ne00:"
    'Name/path of the excel file to be printed to acrobat
    msExcel.Workbooks.Open "C:\test.xls"
    'Name/Path of the Post Script file that'll be generated in the process(from which we generate the PDF)
    strPSpath = "C:\test.ps"
    'Name/path of the PDF file to be produced
    strPDFpath = "C:\test.pdf"

    msExcel.Worksheets(1).PrintOut ActivePrinter:=ADist, printtofile:=True, prtofilename:=strPSpath
    myPDF.FileToPDF strPSpath, strPDFpath, ""
    msExcel.ActiveWorkbook.Close False
    'Next line kills the .PS file as you don't need it once PDF is generated
    Kill strPSpath
    
    msExcel.Quit
    Set msExcel = Nothing
    Set myPDF = Nothing
    MsgBox "done"
End Sub

Top

Looping through Folders,Sub folders and Files using VB FSO(File System Objects)

'Code by Mahipal Padigela
'Add a Command button to your Form
'Add a reference to 'Microsoft Scripting Runtime'
'Replace 'C:\test' with a valid folder path
'Paste the following code in to your Form code window
Private Sub Command1_Click()
    Dim Fso As Object       'to hold FSO
    Dim fmain As Folder     'to hold reference to top level subfolders
    Dim flevel1 As Folder   'to hold reference to 1st level subfolders
    Dim flevel2 As Folder   'to hold reference to 2nd level subfolders
    Dim aFile As File       'to hold reference to Files
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    'Assign the folder to loop
    Set fmain = Fso.GetFolder("C:\test")   'Pass your folder path here
    
    'this code loops through the folders,subfolders and files
    'this works only upto 2 levels of subfolders
      For Each flevel1 In fmain.SubFolders
          For Each aFile In flevel1.Files
            MsgBox aFile.Path
          Next
         'loops second level subfolders
          If flevel1.SubFolders.Count > 0 Then
              For Each flevel2 In flevel1.SubFolders
                For Each aFile In flevel2.Files
                  MsgBox aFile.Path
                Next
              Next
          End If
      Next
    
    Set fmain = Nothing
    Set flevel1 = Nothing
    Set flevel2 = Nothing
    Set aFile = Nothing
    Set Fso = Nothing
End Sub

Top

Looping through the Tables in a MS WORD Document and accessing specific Text using VB code

'Code by Mahipal Padigela
'Add a Command button to your Form
'Add a reference to 'Microsoft word9.0 object library'
'Replace 'C:\test.doc' with your document path
'Paste the following code in to your Form code window
Private Sub Command1_Click()
    Dim objWord As Object
    Dim objDoc As Word.Document
    Dim tTable As Word.Table
    Dim i As Integer
    Dim j As Integer
      
    Set objWord = CreateObject("word.application")
    objWord.Visible = False
    
    Set objDoc = objWord.Documents.Open("C:\test.doc")
    i = 1
    j = 1
    'Searches for text with red color and makes it bold & underline
    'just as an example.you can replace it according to your use.
    'to access text, use ...RANGE.TEXT 
     For Each tTable In objDoc.Tables
        For i = 1 To tTable.Rows.Count
                For j = 1 To tTable.Columns.Count
                    If tTable.Cell(i, j).Range.Font.Color = wdColorRed Then
                        tTable.Cell(i, j).Range.Font.Bold = True
                        tTable.Cell(i, j).Range.Font.Underline = wdUnderlineSingle
                    End If
                Next j
            j = 1
        Next i
         i = 1
    Next
 
   objDoc.Save
    objDoc.Close
    Set tTable = Nothing
    Set objDoc = Nothing
    objWord.Application.Quit
    Set objWord = Nothing
    MsgBox "done"
End Sub

Top

Moving a Control at runtime using VB code(Example demonstrates moving a Command button on a Form)

'Code by Mahipal Padigela
'Add a Command button to your Form
'Set the Command1 "MousePointer" property to 15- Size All
'Paste the following code in to your Form code window
Dim intx As Single
Dim inty As Single

Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
    intx = X
    inty = Y
End If
End Sub

Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
       Command1.Left = Command1.Left + X - intx
       Command1.Top = Command1.Top + Y - inty
    End If
End Sub

Top

Add a Control to Form at Runtime using VB code

'Code by Mahipal Padigela
'Add a Command button to your Form
'Paste the following code in to your Form code window
Dim WithEvents Btn As CommandButton
Private Sub Command1_Click()
    Set Btn = Controls.Add("VB.CommandButton", "Btn")
    Btn.Caption = "Hello, Click me!!"
    Btn.Left = 1500
    Btn.Top = 500
    Btn.Width = 2000
    Btn.Visible = True
End Sub
Private Sub Btn_Click()
    MsgBox "Hello", vbInformation
End Sub
Private Sub Form_Terminate()
    Set Btn = Nothing
End Sub

Top

 
www.mahipalreddy.com
Terms and Conditions of Use
Copyright 2004 - 2006 Mahipal Padigela. All rights reserved.