VBA Dir Function to Get Sub Directories

Get Sub Directories using VBA Dir Function

The below function is used to get the immediate sub-directories for a given directory. If you want to dig deep into the directory structure then you need to iterate the sub-directories as well

Sub Get_All_SubDirectories()

Dim arSubDir() As String
Dim sSubDir As String

sSubDir = GetSubDir("d:\trash\")

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

If LenB(sSubDir) <> 0 Then
arSubDir = Split(sSubDir, ";")
For i1 = 0 To UBound(arSubDir)
Debug.Print arSubDir(i1)
Next i1
End If

End Sub


Function GetSubDir(ByVal sPath As String, Optional ByVal sPattern As Variant) As Variant

Dim sDir As String
Dim sDirLocationForText As String

On Error GoTo Err_Clk

If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"

If IsMissing(sPattern) Then
sDir = Dir$(sPath, vbDirectory)
Else
sDir = Dir$(sPath & sPattern, vbDirectory)
End If
' -----------------------------------------------------------
' Coded by Shasur for http://vbadud.blogspot.com
' -----------------------------------------------------------

Do Until LenB(sDir) = 0

' -----------------------------------------------------
' This will be the location for the sub directory
' -----------------------------------------------------
If sDir <> "." And sDir <> ".." Then
sDirLocationForText = sDirLocationForText & ";" & sPath & sDir
End If
sDir = Dir$

Loop

If Left$(sDirLocationForText, 1) = ";" Then sDirLocationForText = Right(sDirLocationForText, Len(sDirLocationForText) - 1)
GetSubDir = sDirLocationForText

Err_Clk:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Function

Get User Name using Split Function

This is a simple way of using the split function to get the user name

Sub Get_EMail_User_Name()

sEmail = "joe@gmail.com"

arTemp = Split(sEmail, "@")

sDomain = arTemp(LBound(arTemp))
End Sub

Cheers
Shasur

Get Domain Name from eMail (Split Function)

This is a simple way of using the split function to get the domain name

Sub Get_Domain()

sEmail = "joe@gmail.com"

arTemp = Split(sEmail, "@")

sDomain = arTemp(UBound(arTemp))
End Sub

Cheers
Shasur