Brief Introduction
Microsoft Visual Basic for Application (VBA) is a powerful tool for Microsoft Office Suite. General users usually only use a small portion of functions Microsoft Office provides and never have a chance to touch VBA. However, Microsoft Excel is an great tool to do math and graph. If VBA is used with the Excel functions you can achieve dramatic improvement in productivity and avoid tedious repetitive work. Further VBA makes your work more fun than dry boring work. This article is focusing on how to utilize Window API functionality and access Windows file system. Sample VBA codes are provided to illustrate the method. Some of the codes are from the Internet. You can reuse the code in your project freely.
Add a BrowseForFolder button in VBA dialog window
VBA does not provide a folder selection dialog component / control. Windows Shell Application API provides this function. In VBA code, we can easy call Windows Shell Application object and utilize this function. The key part is VBA CreateObject function. We can use this function to create an object that point to “Shell.Application” and then use its “BrowseForFolder” function. See the sample code below.
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'Function purpose: To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level
Dim ShellApp As Object
'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0
'Destroy the Shell Application
Set ShellApp = Nothing
'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
Exit Function
Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False
End Function
In your VBA project, you can add a textbox control to hold the returned folder name and a button control on your form, then create a click event handler for the button like the following.
Private Sub CommandButton1_Click()
foldername = BrowseForFolder
tbFolderName.Value = foldername
End Sub
Create a list of files with a given extension
The FileSystemObject (FSO) provides an API to access the Windows filesystem, providing access to files, drives, text streams etc. The FSO is embedded within the Microsoft Scripting run-time, and is available to stand-alone applications (coded using Visual Basic, for example), to web page designers using VBScript or JScript and to users of Microsoft Office applications using Visual Basic for Applications (VBA). Here I introduce the FSO and to create a example function that is used to get a list of files with a given extension. We still need use CreateObject to crate an object to point “Scripting.FileSystemObject”. After that we can call its functions. See detail in the following sample VBA code. In order to get the list and number of files, we need create two variables outside the subroutine. In your project, these variables can be declared as private variable in modules, forms and classes.
Private FileList(100) As String
Private nFiles As Integer ' base = 1
Sub ListFilesInFolder(SourceFolderName As String, Extension As String)
Dim FSO, SourceFolder, SubFolder, FileItem
Dim r As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
Set FC = SourceFolder.Files
r = 1
For Each FileItem In FC
FileType = Right(FileItem, 4)
If (FileType = Extension) Then
FileList(r) = FileItem.Name
r = r + 1
End If
Next FileItem
nFiles = r - 1
End Sub
To use the function is pretty easy, just call the subroutine like the following.
ListFilesInFolder foldername, ".txt"
Create, read, and write text files
In VBA we can use the same “Scripting.FileSystemObject” to process text files. The following is an example to read text file and extract useful data from it. Similarly, we can use “Scripting.FileSystemObject” to write data to a text file.
Private Sub ReadDataFile(Filename As String)
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim oFS
Set oFS = oFSO.OpenTextFile(filename)
nline = 1
Do Until oFS.AtEndOfStream
sText = oFS.ReadLine
If (nline = 2) Then
obsdt = Mid(sText, 3)
End If
If (nline >= 9) Then
temparr = Split(sText, " ")
ind = Val(Left(sText, 2))
obsvals(ind) = temparr(12)
End If
nline = nline + 1
Loop
End Sub
Create, read, and write binary files
In addition to text file, VBA also can handle binary files. Here are example code for creating, reading and editing a binary file. The key part is using open function to open a file in binary format and use get to read data and use put to write data. At the top of code sample, we declare an data type with multiple fields. We will use it to hold data and read and write data to file as an unit.
Type MyRec
Name As String * 10
Age As Integer
End Type
Sub CreateBinaryFile()
Dim intUnit As Integer
Dim typInfo(5) As MyRec
Dim lngIndex As Long, lngPos As Long
intUnit = FreeFile
Open ThisWorkbook.Path & "Test.bin" For Binary Access Read Write As intUnit Len = Len(typInfo(1))
typInfo(1).Name = "Andy"
typInfo(1).Age = 40
typInfo(2).Name = "Bob"
typInfo(2).Age = 20
typInfo(3).Name = "Charlie"
typInfo(3).Age = 24
typInfo(4).Name = "David"
typInfo(4).Age = 58
typInfo(5).Name = "Ernie"
typInfo(5).Age = 32
lngPos = 1
For lngIndex = 1 To 5
Put #intUnit, lngPos, typInfo(lngIndex)
lngPos = lngPos + Len(typInfo(lngIndex))
Next
Close intUnit
End Sub
Sub ReadBinaryFile()
Dim intUnit As Integer
Dim typInfo As MyRec
Dim lngIndex As Long, lngPos As Long
intUnit = FreeFile
Open ThisWorkbook.Path & "Test.bin" For Binary Access Read As intUnit Len = Len(typInfo)
lngPos = 1
For lngIndex = 1 To 5
Get #intUnit, lngPos, typInfo
MsgBox "Record " & lngIndex & " contains " & vbLf & typInfo.Name & " Aged " & typInfo.Age
lngPos = lngPos + Len(typInfo)
Next
Close intUnit
End Sub
Sub EditBinaryFile()
Dim intUnit As Integer
Dim typInfo As MyRec
Dim lngIndex As Long, lngPos As Long
intUnit = FreeFile
Open ThisWorkbook.Path & "Test.bin" For Binary Access Write As intUnit Len = Len(typInfo)
typInfo.Name = "Peter"
typInfo.Age = 18
' Replace record 3 - Charlie
lngPos = 1 + ((3 - 1) * Len(typInfo))
Put #intUnit, lngPos, typInfo
Close intUnit
' show changes
ReadBinaryFile
End Sub




