Originally Posted by
June7
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