Excel Forum

Code: Select all

Option Explicit
Function FolderExist(Path As String) As Boolean
    On Error Resume Next
    If Not Dir(Path, vbDirectory) = vbNullString Then
        FolderExist = True
        End If
        On Error GoTo 0
End Function

Sub TestFolder()
    Dim sDir As String
    Dim rng As Range
    If FolderExist("R:\SQA SupplierImprovementPjt\History Parts Quality Project\WORKING PROFILE\Pic Input NCR IQC\") Then
        ChDir "R:\SQA SupplierImprovementPjt\History Parts Quality Project\WORKING PROFILE\Pic Input NCR IQC\"
'        ThisWorkbook.SaveAs ("Test.xls") 'Save file name as "Test"
    Else
    On Error Resume Next
        MkDir "R:\SQA SupplierImprovementPjt\"
        MkDir "R:\SQA SupplierImprovementPjt\History Parts Quality Project\"
        MkDir "R:\SQA SupplierImprovementPjt\History Parts Quality Project\WORKING PROFILE\"
        MkDir "R:\SQA SupplierImprovementPjt\History Parts Quality Project\WORKING PROFILE\Pic Input NCR IQC\"
    End If
        sDir = "R:\SQA SupplierImprovementPjt\History Parts Quality Project\WORKING PROFILE\Pic Input NCR IQC\"
    For Each rng In Sheets("Sheet1").Range("A1:A15")
        MkDir sDir & rng
    Next rng
'    ChDir "R:\SQA SupplierImprovementPjt\History Parts Quality Project\WORKING PROFILE\Pic Input NCR IQC\RJN-T1144-01-01"
'    ThisWorkbook.SaveAs ("Test.xls") 'Save file name as "Test"
End Sub