Create Database with ADO / ADO Create Database

Create Microsoft Access Database programmatically using ADO

Programmers who have used DAO will definitely miss the CreateDatabase in ADO. Here is one method to do the same using ADO.

For doing this you need to include the ADO Extensions library in the project reference.


This library consists of classes and methods to handle the Schema related activities like creation of database, table etc

The following code uses the Catalog object of the ADOX to create a new Microsoft Access database

Sub Create_DB_and_Table_Using_ADOX()

Dim oDB As ADOX.Catalog
Dim sDBPAth As String

Dim sConStr As String
Dim oCn As ADODB.Connection
Dim oCM As ADODB.Command

' ------------------------
' Set the Path and Connection String
' ------------------------
sDBPAth = "c:\Temp\MyAccounts.mdb"
sConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sDBPAth & ";"

' ------------------------
' Create New ADOX Object
' ------------------------
Set oDB = New ADOX.Catalog
oDB.Create sConStr

Set oCn = New ADODB.Connection
oCn.ConnectionString = sConStr
oCn.Open

Set oCM = New ADODB.Command
oCM.ActiveConnection = oCn
oCM.CommandText = "Create Table Users (" & _
"[EmpNo] Decimal(6), " & _
"[EmpName] Text(150), " & _
"[JoinDate] Date " & _
")"
oCM.Execute
' ------------------------
' Release / Destroy Objects
' ------------------------
If Not oCM Is Nothing Then Set oCM = Nothing
If Not oCn Is Nothing Then Set oCn = Nothing
If Not oDB Is Nothing Then Set oDB = Nothing


' ------------------------
' Error Handling
' ------------------------
Err_Handler:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub

Though I used the ADODB Query deliberately to create a Table in the new database, you can try it with the Table object in ADOX

Excel VBA - FindAll Method

One out of two code module in Excel VBA will have cells.Find or Findnext method. Here is a generic function - FindAll that can be used to retrieve information of all matching cells.

Function FindAll(ByVal sText As String, ByRef oSht As Worksheet, ByRef sRange As String, ByRef arMatches() As String) As Boolean

' --------------------------------------------------------------------------------------------------------------
' FindAll - To find all instances of the1 given string and return the row numbers.
' If there are not any matches the function will return false
' --------------------------------------------------------------------------------------------------------------

On Error GoTo Err_Trap

Dim rFnd As Range ' Range Object
Dim iArr As Integer ' Counter for Array
Dim rFirstAddress ' Address of the First Find

' -----------------
' Clear the Array
' -----------------
Erase arMatches
Set rFnd = oSht.Range(sRange).Find(What:=sText, LookIn:=xlValues, LookAt:=xlPart)
If Not rFnd Is Nothing Then
rFirstAddress = rFnd.Address
Do Until rFnd Is Nothing
iArr = iArr + 1
ReDim Preserve arMatches(iArr)
arMatches(iArr) = rFnd.Address ' rFnd.Row ' Store the Row where the text is found
Set rFnd = oSht.Range(sRange).FindNext(rFnd)
If rFnd.Address = rFirstAddress Then Exit Do ' Do not allow wrapped search
Loop
FindAll = True
Else
' ----------------------
' No Value is Found
' ----------------------
FindAll = False
End If


' -----------------------
' Error Handling
' -----------------------
Err_Trap:
If Err <> 0 Then
MsgBox Err.Number & " " & Err.Description, vbInformation, "Find All"
Err.Clear
FindAll = False
Exit Function
End If
End Function

The functions accepts three input parameters - Text To be searched, Worksheet, Search Range and one output Array parameter

The function searches the occurrence of that particular text in the specified range of the Excel Sheet and returns address(es) of all occurrences. The Search is by default part of Excel Cells and not whole cell

Here is a way to implement the function:

Case I : Get Addresses of all matching cells

Sub Drive_The_FindAll_Function()

' Sample Sub to Drive the Function

Dim arTemp() As String 'Temp Array
Dim bFound As Boolean 'Flag
Dim i1 As Integer 'Array Counter

bFound = FindAll("SampleText", ActiveSheet, "B1:C41", arTemp())

If bFound = True Then
For i1 = 1 To UBound(arTemp)
' The Address Can be used for extracting data
MsgBox arTemp(i1)
Next i1
Else
MsgBox "Search Text Not Found"
End If



End Sub

Case II : Modify Data according to Find

In the example shown below, FindAll function is used to search 'SampleText' in column C and if the text is found a Flag 'X' is set against column D

Sub Fill_Based_on_FindAll()

' For All Matching Values in Second Column
' Add 'X' to Column D

Dim arTemp() As String 'Temp Array
Dim bFound As Boolean 'Flag
Dim i1 As Integer 'Array Counter


bFound = FindAll("SampleText", ActiveSheet, "C:C", arTemp())

If bFound = True Then
For i1 = 1 To UBound(arTemp)
' The Row Number Can be used for extracting data
ActiveSheet.Range(arTemp(i1)).Offset(0, 1).Value = "X"
Next i1
Else
MsgBox "Search Text Not Found"
End If



End Sub

Case III : Get the Number of Occurrences

A simple one though; number of occurrences of the text in particular range

Sub Instances_Based_on_FindAll()

' Get the Number of Instances

Dim arTemp() As String 'Temp Array
Dim bFound As Boolean 'Flag
Dim i1 As Integer 'Array Counter


bFound = FindAll("SampleText", ActiveSheet, "C:C", arTemp())

If bFound = True Then
MsgBox "No of instances : " & UBound(arTemp)
Else
MsgBox "Search Text Not Found"
End If



End Sub

Disabling Macros in a Workbook (Excel VBA)

Many workbooks will have macros embedded with it. When you open the Workbook in Excel, you would have noticed the Dialog with options Enable Macros / Disable Macros

The following code snippet (Excel 2003) uses Application.FileDialog method to open a Workbook and disables the macros in it:

Sub Open_File_With_Macros_Disabled()

Dim i1 As Integer
Dim secAutomation As MsoAutomationSecurity

secAutomation = Application.AutomationSecurity

Application.AutomationSecurity = msoAutomationSecurityForceDisable

With Application.FileDialog(msoFileDialogOpen)
.Show
For i1 = 1 To .SelectedItems.Count
MsgBox .SelectedItems(i1)
Workbooks.Open .SelectedItems(i1)

Next i1
End With

Application.AutomationSecurity = secAutomation

End Sub

Automate Lotus Notes eMail using Visual Basic

How to send Lotus Notes mail messages with Microsoft Visual Basic

The following Visual Basic code will send a Notes e-mail message. The code includes examples of code to include an attachment and to save the sent message, which are both optional and can be removed if desired.

Dim Maildb As Object
Dim MailDoc As Object
Dim Body As Object
Dim Session As Object
'Start a session to notes
Set Session = CreateObject("Lotus.NotesSession")
'This line prompts for password of current ID noted in Notes.INI
Call Session.Initialize
'or use below to supply password of the current ID
'Call Session.Initialize("")
'Open the mail database in notes
Set Maildb = Session.GETDATABASE("", "c:\notes\data\mail\mymail.nsf")
If Not Maildb.IsOpen = True Then
Call Maildb.Open
End If
'Create the mail document
Set MailDoc = Maildb.CREATEDOCUMENT
Call MailDoc.ReplaceItemValue("Form", "Memo")
'Set the recipient
Call MailDoc.ReplaceItemValue("SendTo", "John Doe")
'Set subject
Call MailDoc.ReplaceItemValue("Subject", "Subject Text")
'Create and set the Body content
Set Body = MailDoc.CREATERICHTEXTITEM("Body")
Call Body.APPENDTEXT("Body text here")
'Example to create an attachment (optional)
Call Body.ADDNEWLINE(2)
Call Body.EMBEDOBJECT(1454, "", "C:\filename", "Attachment")
'Example to save the message (optional)
MailDoc.SAVEMESSAGEONSEND = True
'Send the document
'Gets the mail to appear in the Sent items folder
Call MailDoc.ReplaceItemValue("PostedDate", Now())
Call MailDoc.SEND(False)
'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
Set Body = Nothing
Set Session = Nothing

Note: The Visual Basic programmer needs to set the Reference to use Lotus Domino objects prior to implementing this function. To enable the Lotus Notes classes to appear in the Visual Basic browser, you must execute the following within VB: Select Tools, References and select the checkbox for 'Lotus Notes Automation Classes'.

The above code is from the IBM support. GETDATABASE given here is pointing to the sample MailDB; you need to change that to your DB.

You can do that by

UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
'Open the mail database in notes
Set Maildb = Session.GETDATABASE("", MailDbName)

To send it through Microsoft Outlook refer http://vbadud.blogspot.com/2007/04/vba-email-automation-vba-mail.html

Automate Email, VBA Email, Send Email from Excel, VBA Mail automation, Mail Automation, Lotus Notes VBA, Automate Lotus Notes, Send Mail from Lotus Notes, Link Excel with Lotus Notes,Microsoft Lotus Notes Mail Automation, Excel VBA Mail, MAPI, Send Multiple eMails

Reducing Size of Microsoft Access Database (Compact Database)

Compact MS Access Database using VBA (ADO Code)

If the DB Size is huge the compact DB utility [Compact & Repair Database (Tools-->Database utilities-->Compact and Repair Database) should reduce the DB Size.

Here is the code for doing the same using VB/VBA (ADO)

Public Sub CompactDB()
'Microsoft Jet and Replication objects
Dim objJE As New JRO.JetEngine, strSource As String, strTarget As String
DoEvents
Busy True
strSource = " "
strTarget = " "
objJE.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strSource & ";", "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strTarget & ";Jet OLEDB:Engine Type=4;"
Busy False
'Engine type:
'Access 97 = 4
'Access 2000 = 5
End Sub

Excel VBA - Change Font Color for Part of Text

Formatting Text (Cell Contents) Partially using Excel VBA

Sometimes, you need to differentiate some parts of text in an Excel cell. This can be done using formatting those characters.

Here is the way that can be done using VBA using the Characters property


Sub Color_Part_of_Cell()
'Print ActiveCell.Characters.Count
With ActiveCell.Characters(2).Font
.Color = RGB(36, 182, 36)
End With

With ActiveCell.Characters(2, 2).Font
.Color = RGB(36, 182, 36)
End With

With ActiveCell.Characters(, 2).Font
.Color = RGB(36, 182, 36)
End With

End Sub

The output of the above is

Syntax

expression.Characters(Start, Length)

expression Required. An expression that returns an object in the Applies To list.

Start Optional Variant. The first character to be returned. If this argument is either 1 or omitted, this property returns a range of characters starting with the first character.

Length Optional Variant. The number of characters to be returned. If this argument is omitted, this property returns the remainder of the string (everything after the Start character)

The same characters object can be used to make a character Bold / Italic

Orientation of Cell Through Excel VBA

Almost most of the Excel VBA programmers would have the requirement to change the orientation of the cell.

Here is an example

Sub Orientations()

ActiveCell.Orientation = xlHorizontal
ActiveCell.Orientation = xlVertical
ActiveCell.Orientation = xlUpward
ActiveCell.Orientation = xlDownward
ActiveCell.Orientation = 45
ActiveCell.Orientation = -45

End Sub

The orientation of the cell in Excel would be as follows:

ShutDown Windows using VBA

VBA Function to Logoff /VBA Function to Restart Windows



Option Explicit

' Win API Declarations

Const MF_BYPOSITION = &H400&

Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4

Private Declare Function ExitWindowsEx Lib "user32.dll" ( _
ByVal uFlags As Long, _
ByVal dwReserved As Long) As Long


Use the function with atmost caution, you will not be warned by Windows for Shutdown / Restart. Save all your work before trying this example:)

Function Common_ShutDown_Logoff()


'Shutdown Windows
Call ExitWindowsEx(EWX_SHUTDOWN, 0)

'Restart Windows
Call ExitWindowsEx(EWX_REBOOT, 0)

'logoff Windows
Call ExitWindowsEx(EWX_LOGOFF, 0)


End Function

Disable Close Button in UserForm (VBA)

Disable Close Button in Userform (Visual Basic)

Option Explicit

'API Declarations

Const MF_BYPOSITION = &H400&


Private Declare Function GetSystemMenu Lib "user32" _
(ByVal hwnd As Long, _
ByVal bRevert As Long) As Long

Private Declare Function RemoveMenu Lib "user32" _
(ByVal hMenu As Long, _
ByVal nPosition As Long, _
ByVal wFlags As Long) As Long




Public Sub DisableCloseWindowButton(frm As Form)

Dim hSysMenu As Long

'Get the handle of the Window
hSysMenu = GetSystemMenu(frm.hwnd, 0)

'Disable the close button of the Form
RemoveMenu hSysMenu, 6, MF_BYPOSITION

'Remove the seperator bar
RemoveMenu hSysMenu, 5, MF_BYPOSITION

End Sub

Detecting duplicate values (Excel VBA)

Check presence of values in a column/range using Excel VBA

Most often a programmer would be given a job of Insert/Update scenarion in EXcel. That is, Insert a new row if a specific value does not exist; if it does then update some. So the process is to check for existence of a specific value

Here is a generic function ;

Sub CheckForExistence()

myVal = "Sample"
myRange = "A:A"
If Check_Val_Existence(myVal, myRange) = True Then
MsgBox "Value exists"
End If
End Sub

This used the Find Method. This method finds specific information in a range, and returns a Range object that represents the first cell where that information is found. Returns Nothing if no match is found.


Function Check_Val_Existence(ByVal sText, ByVal sRange) As Boolean

Dim rFnd As Range
Dim sText As String

Set rFnd = ActiveSheet.Range(sRange).Find(What:=sText, LookAt:=xlPart)
If Not rFnd Is Nothing Then
Check_Val_Existence = True
Else
Check_Val_Existence = False
End If

End Function

Automatically Event Repeat in Excel VBA (OnTime Method)

VBA Code that can run at a fixed time can be done using the OnTime Method.

OnTime Method schedules a procedure to be run at a specified time in the future (either at a specific time of day or after a specific amount of time has passed).

expression.OnTime(EarliestTime, Procedure, LatestTime, Schedule)

expression Required. An expression that returns an Application object.

EarliestTime Required Variant. The time when you want this procedure to be run.

Procedure Required String. The name of the procedure to be run.

LatestTime Optional Variant. The latest time at which the procedure can be run. For example, if LatestTime is set to EarliestTime + 30 and Microsoft Excel is not in Ready, Copy, Cut, or Find mode at EarliestTime because another procedure is running, Microsoft Excel will wait 30 seconds for the first procedure to complete. If Microsoft Excel is not in Ready mode within 30 seconds, the procedure won’t be run. If this argument is omitted, Microsoft Excel will wait until the procedure can be run.

Schedule Optional Variant. True to schedule a new OnTime procedure. False to clear a previously set procedure. The default value is True.

Remarks

Use Now + TimeValue(time) to schedule something to be run when a specific amount of time (counting from now) has elapsed. Use TimeValue(time) to schedule something to be run a specific time.

Application.OnTime TimeValue("11:00:00"), "StartProc"
Application.OnTime TimeValue("13:00:00"), "EndProc"

Assuming that you have two procedures called StartProc and EndProc the procedures would ne executed at the specified time

Disable Cut & Copy from Popup menu (Excel VBA/Word VBA)

Here is a simple way to disable the Cut & Copy in the Popup menu

Sub Disable_Buttons()

Dim oC1 As CommandBar

Set oC1 = Application.CommandBars("CELL")
oC1.Controls("Cu&t").Enabled = False
oC1.Controls("&Copy").Enabled = False

End Sub

Other menu items can also be handled similarly

To disable the Insert & Delete in the Popup menu

oC1.Controls("&Insert...").Enabled = False
oC1.Controls("&Delete...").Enabled = False

Excel Height of Row - RowHeight using Excel VBA

RowHeight property is used to get the Height

Returns the height of all the rows in the range specified, measured in points (point: Unit of measure referring to the height of a printed character. A point equals 1/72 of an inch, or approximately 1/28 of a centimeter.). Returns null if the rows in the specified range aren’t all the same height. Read/write Variant.

You can use the Height property to return the total height of a range of cells.


Sub Change_Header_Row_Height()


MsgBox "RowHeight = " & Range("A1").RowHeight _
& vbCrLf & "Height = " & Range("A1").Height

Range("A1").RowHeight = 90

End Sub


Differences between RowHeight and Height include the following:

Height is read-only.

If you return the RowHeight property of several rows, you will either get the row height of each of the rows (if all the rows are the same height) or null (if they’re different heights). If you return the Height property of several rows, you will get the total height of all the rows.


Range("A1").Height = 90

would give Object required 424 error

Technorati Profile

Get the Height & Width of Shapes / Figures in Word Document (Word VBA)

Height & Width of Shapes / InlineShapes in Word Document (Word VBA)

Figures are embedded in the word document and when they move they are a nemesis. Programmers are often given the job of aligning, resizing etc. Here is a simple example to get the height of the Shapes. Here you will notice that a particular inline shape has been singled out. You will get to know this if you run this in the document:)

Sub Figure_Attributes()
Dim sRep
sRep = ""
For I = 1 To ActiveDocument.InlineShapes.Count
If ((ActiveDocument.InlineShapes(I).Type > 0 And ActiveDocument.InlineShapes(I).Type <> 7 And ActiveDocument.InlineShapes(I).Type < 18)) Then
Height = ActiveDocument.InlineShapes(I).Height
Width1 = ActiveDocument.InlineShapes(I).Width
ActiveDocument.InlineShapes(I).Select
If Selection.Fields.Count = 0 Then
sRep = sRep & fname & vbTab & Height & vbTab & Width1 & vbCr
End If
End If
Next I
For I = 1 To ActiveDocument.Shapes.Count
Height = ActiveDocument.Shapes(I).Height
Width1 = ActiveDocument.Shapes(I).Width
ActiveDocument.Shapes(I).Select
sRep = sRep & fname & vbTab & Height & vbTab & Width1 & vbCr
Next I
MsgBox "Attributes of all the shapes in " & ActiveDocument.Name & vbCrLf & sRep
End Sub

Paragraph & Character Styles in Word Document (Word VBA)

Export Character Styles from Word Document / Export Paragraph Styles from Word Document

Here is the simple macro for extracting character & paragraph styles from a Word document. This exports the styles to a new word document



Sub Export_Styles_In_Document()

Dim oSource As Document
Dim oRep As Document
Dim oPara As Paragraph

Set oRep = Documents.Add



Set oSource = ActiveDocument
For I = 1 To oSource.Styles.Count
If oSource.Styles(I).Type = wdStyleTypeParagraph Then
SType = "Para"
oRep.Bookmarks("\EndOfDoc").Select
Set oPara = oRep.Paragraphs.Add
Set oPara = oRep.Paragraphs.Add
oPara.Range.Text = SType & ": " & oSource.Styles(I).NameLocal
Else
SType = "Char"
End If
Next I
For I = 1 To oSource.Styles.Count
If oSource.Styles(I).Type = wdStyleTypeParagraph Then
SType = "Para"
Else
SType = "Char"
oRep.Bookmarks("\EndOfDoc").Select
Set oPara = oRep.Paragraphs.Add
Set oPara = oRep.Paragraphs.Add
oPara.Range.Text = SType & ": " & oSource.Styles(I).NameLocal
End If
Next I
oRep.Activate
End Sub


Visual Basic Common Dialog

Opening Files with Common Dialog

Common Dialog not only replaces three controls (Drive, Directory and FileList), but also is easier to program. It is supported in Visual Basic and VBA as well. The new VB.NET has the same functionality in the OpenFileDialog class

Let us have a small form created for explaining CommonDialog. Let us have a small form with a Text Box and a Command Button. On Clicking the Command Button, the selected file should be displayed in the Text Box

Sample Form:



To use the CommonDialog you need to include the component to your project. You can do so as follows:





Once The component is included, the CommonDialog will be displayed in the ToolBox




Drag the CommonDialog to the form. You will see a small rectangle there. CommonDialog is visible in the Design time only (it is not visible during runtime)




Add the following code to show the CommonDialog box and show the selected file in the text box


Private Sub Command1_Click()

CommonDialog1.DialogTitle = "Select the File..."

CommonDialog1.Flags = cdlOFNFileMustExist

CommonDialog1.Filter = "Microsoft Excel Workbooks (*.xls)*.xls"

CommonDialog1.ShowOpen

If Len(CommonDialog1.FileName) <> 0 Then

Text1.Text = CommonDialog1.FileName

End If






You can restrict the type of files to be selected using the filter Command. Some common filters are




Selecting Microsoft Word Documents
CommonDialog1.Filter = "Microsoft Word Documents (*.doc)*.docMicrosoft Word Documents (*.rtf)*.rtf"

Selecting Image Files
CommonDialog1.Filter = "Image Files(*.BMP;*.JPG;*.GIF)*.BMP;*.JPG;*.GIF"

Selecting Microsoft Word Documents (Including RTF Files)
CommonDialog1.Filter = "Microsoft Word Documents (*.doc;*.rtf)*.doc;*.rtf"

Selecting Microsoft Excel Workbooks
CommonDialog1.Filter = "Microsoft Excel Workbooks (*.xls)*.xls"

Selecting Excel Addins
CommonDialog1.Filter = "Microsoft Excel Addins (*.xla;*.xll)*.xla;*.xll"

Selecting Any files
CommonDialog1.Filter = "All files (*.*)*.*"

Selecting Text files
CommonDialog1.Filter = "Text files (*.txt)*.txt"

Selecting ASCII files
CommonDialog1.Filter = "ASCII files (*.txt;*.log)*.txt;*.log"

See also:

OpenFileDialog in Visual Basic .Net

Search and Open Files using Excel VBA (FileSearch)

Open Excel Files - Open Dialog - GetOpenFilename Method

Selecting a Folder in VB.Net

Browse a Folder / Select a Folder Thru Shell

SaveAs Dialog - Controlled Save

Excel VBA - install an Excel Add-in (XLA or XLL)

Adding Addins Automatically using VBA


Most of today's Excel VBA code are as Addins (XLA or XLL). As an organization progresses there comes many revisions for the Addin - hence the need to update the program.

Here is a simple way to add a new addin:

Sub Add_an_Addin()

Dim oAddin As AddIn
Dim oTempBk As Workbook


Set oTempBk = Workbooks.Add

Set oAddin = AddIns.Add("E:\CostBenefit1.0.xla", True)
oAddin.Installed = True

oTempBk.Close

End Sub


If you wonder why a temporary workbooks is added - it is because to avoid the Run-time error '1004': Unable to get the Add property of the AddIns class or Run-time error '1004': Add method of addins class failed exceptions that are raised when there are no workbooks. Just be safe!!

Show All Processes using VBA

Get All Processes using Win API Functions

'Declarations
Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Const MAX_PATH As Integer = 260
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)

' API Functions to get the processes
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long


Sub Load_Process_To_ListBox()


Dim hSnapShot As Long '* Handle
Dim uProcess As PROCESSENTRY32 '* Process
Dim lRet '* Return Val

On Error Resume Next

'Takes a snapshot of the running processes and the heaps, modules, and threads used by the processes
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)

uProcess.dwSize = Len(uProcess)

'Retrieve information about the first process encountered in our system snapshot

lRet = Process32First(hSnapShot, uProcess)

Do While lRet
lRet = Process32Next(hSnapShot, uProcess)

' Trim the unwanted characters at the end of process
lstProcess.AddItem Left$(uProcess.szExeFile, IIf(InStr(1, uProcess.szExeFile, Chr$(0)) > 0, InStr(1, uProcess.szExeFile, Chr$(0)) - 1, 0))
Loop


CloseHandle hSnapShot

End Sub



Private Sub UserForm_Initialize()

' Call the Function

Load_Process_To_ListBox

End Sub

Companies House

Duport provide company formation, company credit reports and director reports.

Run a VB6.0 Executable from Excel/Word

Run an Executable from Excel VBA / Word VBA

If you need to use some grid for showing data / use the feautres in Visual Basic 6.0 that arenot available in VBA, you can create the application in VB6.0 or anyother program and show the User Interface in VBA code


Sub Run_VB6App_FromWord()

--- Some VBA Code here

sCmd = "C:\Program Files\MyFile.exe"
vntResult = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(sCmd, 1))
GetExitCodeProcess vntResult, lngExitCode

' -----------------------------------------------------------
' Coded by Shasur for http://vbadud.blogspot.com
' -----------------------------------------------------------

Do
GetExitCodeProcess vntResult, lngExitCode
DoEvents
Loop While lngExitCode = STILL_ACTIVE

--- some more VBA Code

End Sub


The above program will show the MyFile executable till the user clicks OK/Cancel. Once the application is closed the control will return to the calling VBA program

This used WinAPI Functions

Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Now it depends on how you use the external application. The most often used scenario will be to store the output from the called application (External App) to Registry or Database

VBA Read Text Files (With Leading & Trailing Spaces)

Read Data frm Text Files (VBA)


Reading Text Files using VBA is one of the major development activity of programmers. There are multiple ways to read a file

1. Input # Statement
2. Input Function
3. Get Function
4. File System Object Functions


Input # Statement

Dim MyString, MyNumber
Open "c:\test.txt" For Input As #1 ' Open file for input.
Do While Not EOF(1) ' Loop until end of file.
Input #1, MyString, MyNumber ' Read data into two variables.
Debug.Print MyString, MyNumber ' Print data to the Immediate window.
Loop
Close #1 ' Close file.

However, the bug here is Input # does not take the leading or trailing spaces with it. That is, ' My Name is ' becomes 'My Name is'. This will not be the correct one as we need to get the spaces also

Then Input function comes handy

Dim MyChar
Open "c:\test.txt" For Input As #1    ' Open file.
Do While Not EOF(1)    ' Loop until end of file.
  MyChar = Input(1, #1)    ' Get one character.
  Debug.Print MyChar    ' Print to the Immediate window.
Loop
Close #1    ' Close file.

However, the bug here will be the input that one needs - the number of characters to be extracted.

The obvious option is File system object


Sub Read_text_File()

Dim oFSO As New FileSystemObject
Dim oFS


Set oFS = oFSO.OpenTextFile("c:\textfile.TXT")

Do Until oFS.AtEndOfStream
sText = oFS.ReadLine
Loop


End Sub

This will read line-by line. all you need to add the Microsoft Scripting Runtime in the reference

Happy reading files:)