HTML Code:
'Open Zone Folder under different conditions
Private Sub btnOpenZone_Click()
Dim db As Dao.Database
Set db = CurrentDb
Dim rsFolder As Dao.Recordset
Dim rsExistingZone As Dao.Recordset
Dim OpenExistingZone As String
Dim ExistingZoneCWP As String
Dim oSQL As String
Dim Path_Link As String
Dim ZONE As String
Dim CWP As String
Dim PathCWP As String
Dim PathZone As String
Dim answer As Integer
Dim ZoneFolderName As String
'Get subdirectories for Zone
Set rsFolder = db.OpenRecordset("tbl_PathsZoneFolderName", dbOpenDynaset, dbSeeChanges)
'Get path from table tbl_Paths
Path_Link = Nz(DLookup("[PathLink]", "tbl_Paths", "[PathID] = 4"), "")
'Get CWP number from form tbl_Tracking
CWP = Nz(DLookup("[EHT_EWP]", "[tbl_Tracking]", "[P_Iso_Dwg] ='" & Me.txtPIsoDwg & "'"), "")
'Get zone number from table tbl_Tracking
ZONE = Nz(DLookup("[EHT_Zone]", "[tbl_Tracking]", "[P_Iso_Dwg] ='" & Me.txtPIsoDwg & "'"), "")
'Create CWP path
PathCWP = Path_Link & CStr(CWP) ' & "\"
'Create Zone path
PathZone = PathCWP & "\" & CStr(ZONE)
'Message for missing path in table tbl_Paths
If Path_Link = "" Then
MsgBox "Path not assigned in tbl_Paths", vbExclamation, "Empty Path"
Exit Sub
End If
'Message, zone cell is empty on tracking form
If ZONE = "" Then
MsgBox "Zone not assigned yet.", vbExclamation, "EHT Zone"
Exit Sub
End If
'Create paths
PathCWP = Path_Link & CStr(CWP)
PathZone = PathCWP & "\" & CStr(ZONE)
'Part 1
'Open existing directory for active record for which /CWP/Zone directory was created
If Len(Dir(PathZone, vbDirectory)) <> 0 Then
DoCmd.Hourglass True
OpenNativeApp (PathZone)
DoCmd.Hourglass False
Exit Sub
End If
'Part 2.
'Check if another CWP directory has Zone assigned for active record and if does open it (/differentCWP/zone).
If Len(Dir(PathCWP, vbDirectory)) = 0 Then
'Get CWP for active zone
oSQL = "SELECT tbl_Tracking.EHT_Zone, tbl_Tracking.EHT_EWP"
oSQL = oSQL & " FROM tbl_Tracking"
oSQL = oSQL & " WHERE tbl_Tracking.EHT_Zone = '" & Me.txtEhtZone & "'"
Set rsExistingZone = db.OpenRecordset(oSQL)
With rsExistingZone
If Not .BOF And Not .EOF Then
.MoveLast
.MoveFirst
Do Until rsExistingZone.EOF
ExistingZoneCWP = rsExistingZone("EHT_EWP")
rsExistingZone.MoveNext
OpenExistingZone = Path_Link & "\" & CStr(ExistingZoneCWP) & "\" & CStr(ZONE)
'Open directory
DoCmd.Hourglass True
OpenNativeApp (OpenExistingZone)
DoCmd.Hourglass False
Loop
End If
.Close
Set rsExistingZone = Nothing
End With
End If
'Exit Sub
'Part 3
'Check if CWP folder exists and if it does add active Zone subfolder
If Len(Dir(PathCWP, vbDirectory)) <> 0 Then
answer = MsgBox("No Zone " + ZONE & " folder was created yet under CWP " + CWP & ". Do you want to add Zone " + ZONE & " to CWP " + CWP & "?", vbInformation + vbYesNo + vbDefaultButton2, "Crate zone directory")
If answer = vbNo Then
Exit Sub
Else
MkDir PathZone
Do Until rsFolder.EOF
ZoneFolderName = rsFolder!FolderName
MkDir (PathZone & "\" & ZoneFolderName)
rsFolder.MoveNext
Loop
rsFolder.Close
Set rsFolder = Nothing
End If
MsgBox "done"
'End If
'Open directory
DoCmd.Hourglass True
OpenNativeApp (PathZone)
DoCmd.Hourglass False
'Exit Sub
End If
'Part 4
'If no CWP folder exists then create it with active zone as a subfolder
If Len(Dir(PathZone, vbDirectory)) = 0 Then
answer = MsgBox("CWP folder " + CWP & " with Zone " + ZONE & " wasn't created yet . Do you want to create Zone " + ZONE & " within new folder " + CWP & "", vbInformation + vbYesNo + vbDefaultButton2, "Crate zone directory")
If answer = vbNo Then
Exit Sub
Else
MkDir PathCWP
MkDir PathZone
Do Until rsFolder.EOF
ZoneFolderName = rsFolder!FolderName
MkDir (PathZone & "\" & ZoneFolderName)
rsFolder.MoveNext
Loop
rsFolder.Close
Set rsFolder = Nothing
End If
MsgBox "done"
'Open directory.
DoCmd.Hourglass True
OpenNativeApp (PathZone)
DoCmd.Hourglass False
End If
' Debug.Print Path_Link
' Debug.Print PathCWP
' Debug.Print PathZone
' Debug.Print OpenExistingZone
' Debug.Print ExistingZoneCWP
' Debug.Print ZoneFolderName
End Sub