DEVelopers HUT

'---------------------------------------------------------------------------------------
' Procedure : GetFileNameWOExt
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Return the filename without the extension from a path\filename input
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' strFileWPath - string of a path and filename (ie: "c:\temp\test.xls")
'
' Returns:
' ~~~~~~~~
' test
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2012-Feb-24                 Initial Release
'---------------------------------------------------------------------------------------
Function GetFileNameWOExt(ByVal strFileWPath As String)
On Error GoTo Error_Handler
 
    GetFileNameWOExt = Right(strFileWPath, Len(strFileWPath) - InStrRev(strFileWPath, "\"))
    GetFileNameWOExt = Left(GetFileNameWOExt, InStr(GetFileNameWOExt, ".") - 1)
 
Error_Handler_Exit:
    On Error Resume Next
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Source: GetFileNameWOExt" & vbCrLf & _
            "Error Description: " & Err.Description, _
            vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

'---------------------------------------------------------------------------------------
' Procedure : GetFileExt
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Return the file extension from a path\filename input
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' strFileWPath - string of a path and filename (ie: "c:\temp\test.xls")
'
' Returns:
' ~~~~~~~~
' xls
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2012-Feb-24                 Initial Release
'---------------------------------------------------------------------------------------
Function GetFileExt(ByVal strFileWPath As String)
On Error GoTo Error_Handler
 
    GetFileExt = Right(strFileWPath, Len(strFileWPath) - InStrRev(strFileWPath, "."))
 
Error_Handler_Exit:
    On Error Resume Next
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Source: GetFileExt" & vbCrLf & _
            "Error Description: " & Err.Description, _
            vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

'---------------------------------------------------------------------------------------
' Procedure : FolderExist
' DateTime  : 2009-Oct-02 13:51
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Test for the existance of a Folder/Directory
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFolder - Full path of the folder to be tested for
'---------------------------------------------------------------------------------------
Function FolderExist(sFolder As String) As Boolean
On Error GoTo Error_Handler
 
    If sFolder = vbNullString Then GoTo Error_Handler_Exit
    If Dir(sFolder, vbDirectory) <> vbNullString Then
        FolderExist = True
    End If
 
Error_Handler_Exit:
    On Error Resume Next
    Exit Function
 
Error_Handler:
    If Err.Number <> 52 Then
        MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: FolderExist" & vbCrLf & _
           "Error Description: " & Err.Description, vbCritical, "An Error has Occured"
    End If
    Resume Error_Handler_Exit
End Function

MkDir "C:\databases\"

MkDir "C:\databases\msaccess\"

MkDir "C:\databases\"
MkDir "C:\databases\msaccess\"

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
 
Public Sub MakeFullDir(strPath As String)
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\" 'Optional depending upon intent
    MakeSureDirectoryPathExists strPath
End Sub

Public Sub MyMkDir(sPath As String)
    Dim iStart          As Integer
    Dim aDirs           As Variant
    Dim sCurDir         As String
    Dim i               As Integer
 
    If sPath <> "" Then
        aDirs = Split(sPath, "\")
        If Left(sPath, 2) = "\\" Then
            iStart = 3
        Else
            iStart = 1
        End If
 
        sCurDir = Left(sPath, InStr(iStart, sPath, "\"))
 
        For i = iStart To UBound(aDirs)
            sCurDir = sCurDir & aDirs(i) & "\"
            If Dir(sCurDir, vbDirectory) = vbNullString Then
                MkDir sCurDir
            End If
        Next i
    End If
End Sub