Quote Originally Posted by June7 View Post
See if this gets you somewhere.
Code:
Private Sub Command3_Click()
Const strBasePath = "C:\Users\Owner\June\Forums\Test\"
Dim strP As String
Dim rs As DAO.Recordset

If Dir(strBasePath & Me.EHTCWP & "\" & Me.EHTZone, vbDirectory) <> "" Then
    strP = strBasePath & Me.EHTCWP & "\" & Me.EHTZone
Else
    'search for zone folder
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblTracking WHERE EHTZone='" & Me.EHTZone & "'")
    Do While Not rs.EOF
        If Dir(strBasePath & rs!EHTCWP & "\" & rs!EHTZone, vbDirectory) <> "" Then
            strP = strBasePath & rs!EHTCWP & "\" & rs!EHTZone
            Exit Do
        End If
        rs.MoveNext
    Loop
End If
If strP = "" Then
    If Dir(strBasePath & Me.EHTCWP, vbDirectory) = "" Then MkDir strBasePath & "\" & Me.EHTCWP
    If Dir(strBasePath & Me.EHTCWP & "\" & Me.EHTZone, vbDirectory) = "" Then MkDir strBasePath & Me.EHTCWP & "\" & Me.EHTZone
    strP = strBasePath & Me.EHTCWP & "\" & Me.EHTZone
End If
Debug.Print strP 'or do something else with path
End Sub
This does assume zone folder has not been created in a parent folder that does not have a corresponding record in table.
Thanks June one more time, this is what I ended up with. Works like a charm.



Code:
Private Sub btnOpenZone_Click()
   Dim rs As DAO.Recordset
    Dim rsFolder As DAO.Recordset
    Dim strBasePath As String
    Dim strP As String
    Dim answer As Integer
    Dim ZoneFolderName As String
'Get path from table
    strBasePath = Nz(DLookup("[PathLink]", "tbl_Paths", "[PathID] = 4"), "")
'Get Zone subdirectories
    Set rsFolder = db.OpenRecordset("tbl_PathsZoneFolderName", dbOpenDynaset, dbSeeChanges)
'Message missing path in table tbl_Paths
    If strBasePath = "" Then
        MsgBox "Path not assigned in tbl_Paths", vbExclamation, "Empty Path"
        Exit Sub
    End If
'Message, zone cell empty
    If Me.EHT_Zone = "" Then
        MsgBox "Zone not assigned yet.", vbExclamation, "EHT Zone"
        Exit Sub
    End If
'open zone folder
    If Dir(strBasePath & Me.EHT_EWP & "\" & Me.EHT_Zone, vbDirectory) <> "" Then
        strP = strBasePath & Me.EHT_EWP & "\" & Me.EHT_Zone
    Else
'search for zone folder
        Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_Tracking WHERE EHT_Zone='" & Me.EHT_Zone & "'")
        Do While Not rs.EOF
            If Dir(strBasePath & rs!EHT_EWP & "\" & rs!EHT_Zone, vbDirectory) <> "" Then
                strP = strBasePath & rs!EHT_EWP & "\" & rs!EHT_Zone
                Exit Do
            End If
            rs.MoveNext
        Loop
    End If
    If strP = "" Then
        answer = MsgBox("Zone folder wasn't created yet. Do you want to create it?", vbInformation + vbYesNo + vbDefaultButton2, "Crate zone directory")
        If answer = vbNo Then
            Exit Sub
        Else
            If Dir(strBasePath & Me.EHT_EWP, vbDirectory) = "" Then MkDir strBasePath & "\" & Me.EHT_EWP
            If Dir(strBasePath & Me.EHT_EWP & "\" & Me.EHT_Zone, vbDirectory) = "" Then MkDir strBasePath & Me.EHT_EWP & "\" & Me.EHT_Zone
            strP = strBasePath & Me.EHT_EWP & "\" & Me.EHT_Zone
            Do Until rsFolder.EOF
                ZoneFolderName = rsFolder!FolderName
                MkDir (strP & "\" & ZoneFolderName)
                rsFolder.MoveNext
            Loop
            rsFolder.Close
            Set rsFolder = Nothing
            rs.Close
            Set rs = Nothing
            MsgBox "done"
        End If
    End If
    DoCmd.Hourglass True
    OpenNativeApp (strP)
    DoCmd.Hourglass False
'Debug.Print strP 'or do something else with path
End Sub