vba Function to check for & create folders

[VegasNath]

Hi,

I used to have a really useful vba Function to check for & create folders when passed a string (filepath), but I seem to have mislaid it. Could anyone offer me a pointer to similar?

Thanks

[mbarron]

Code: Select all

Sub makeDir()
If Dir("C:\TestFolder", vbDirectory) = "" Then
     MkDir "C:\TestFolder"
End If
End Sub

[HansV]

I once posted a macro in Woody's Lounge, but it was mangled during the conversion to the new software.
Here is the corrected version:

Code: Select all

Sub CheckFolder(strPath As String)
  Dim fso As Object
  Dim intPos As Integer
  Dim intLen As Integer
  intLen = Len(strPath)
  Set fso = CreateObject("Scripting.FileSystemObject")
  If Left(strPath, 2) = "\\" Then
    ' UNC path - skip server and share
    intPos = InStr(3, strPath, "\")
    intPos = InStr(intPos + 1, strPath, "\")
  Else
  ' drive letter - skip C: part
    intPos = 3
  End If
  Do
    intPos = InStr(intPos + 1, strPath, "\")
    If intPos = 0 Then
      intPos = intLen + 1
    End If
    If fso.FolderExists(Left(strPath, intPos - 1)) = False Then
      fso.CreateFolder Left(strPath, intPos - 1)
    End If
  Loop Until intPos = intLen + 1
  Set fso = Nothing
End Sub

Use like this:

CheckFolder "C:\Reports\Sales\Monthly\March"

or

CheckFolder "\\MyServer\MyShare\MyFolder\Documents"

[VegasNath]

Thanks a lot for this.

Out of interest, is there any reason why this is s sub as opposed to a function?

[HansV]

Because it doesn't return a value. You could make it a function if you prefer...