I have a yes/no message box that will delete an existing table "Well Curve Data" in the database, and recreate a blank one when the user click "Yes". If the user clicks no, it will open a form "Well Curve Analysis" based on the existing "Well Curve Data" table containing old records. But b/f it does that, I have some code to check for errors. For example, one of the fields (FName) in the "Well Curve Data" table contains links to jpegs that will be displayed by the form when opened. I have a for next loop that checks to see if the files are still in the existing (FName) locations specified in the table. If not, I would like the subroutine (based on a button click event) to exit the loop, display an error message, but do not open the "Well Curve Analysis" form. My problem is that the error checking is displaying the error message ("One or more well curve files have been moved.", vbInformation), but is still opening the "Well Curve Analysis" form, even though I don't want it to. I included the code below. Thanks.
Private Sub Command37_Click()
Dim Data1 As Database
Dim S1 As String
Dim rs1 As ADODB.Recordset
Dim DBConnection As ADODB.Connection
Set rs1 = New ADODB.Recordset
Set DBConnection = New ADODB.Connection
Set DBConnection = Application.CurrentProject.Connection
Set Data1 = CurrentDb
If MsgBox("Start new analysis Session?", vbYesNo) = vbYes Then
DeleteTables "Well Curve Data"
S1 = "Create Table [Well Curve Data] (ID COUNTER CONSTRAINT PrimaryKey PRIMARY KEY, [FPath] text(255),[String Group 1] text(255),[String Group 2] text(255),[Assay Name] text(255),[Assay Name Root] text(255),[Well Position] text(255), [Observed Call] text(255), [Orientation] text(255),[Instrument] text(255),[Flagged] Text(255), [TS] text(255),[General Comments] text(255))"
Data1.Execute S1
DoCmd.OpenForm "Import Well Curve Files"
Else
rs1.Open "Select [FPath] From [Well Curve Data]", DBConnection, dOpenStatic, adLockOptimistic
If rs1.BOF And rs1.EOF Then
MsgBox "'Well curve analysis' table is empty.", vbInformation
Exit Sub
End If
For i = 1 To rs1.RecordCount
If FileOrDirExists(rs1.Fields("FPath").Value) = False Then
Msgbox "One or more well curve files have been moved.", vbInformation
GoTo Bypass1:
Else
rs1.MoveNext
End If
Next i
End If
DoCmd.OpenForm "Well Curve Analysis"
Bypass1:
Exit Sub
End Sub
The function below was copied from (
Function FileOrDirExists(PathName As String) As Boolean
'Macro Purpose: Function returns TRUE if the specified file
' or folder exists, false if not.
'PathName : Supports Windows mapped drives or UNC
' : Supports Macintosh paths
'File usage : Provide full file path and extension
'Folder usage : Provide full folder path
' Accepts with/without trailing "\" (Windows)
' Accepts with/without trailing ":" (Macintosh)
Dim iTemp As Integer
'Ignore errors to allow for error evaluation
On Error Resume Next
iTemp = GetAttr(PathName)
'Check if error exists and set response appropriately
Select Case Err.Number
Case Is = 0
FileOrDirExists = True
Case Else
FileOrDirExists = False
End Select
'Resume error checking
On Error GoTo 0
End Function
Private Sub Command37_Click()
Dim Data1 As Database
Dim S1 As String
Dim rs1 As ADODB.Recordset
Dim DBConnection As ADODB.Connection
Set rs1 = New ADODB.Recordset
Set DBConnection = New ADODB.Connection
Set DBConnection = Application.CurrentProject.Connection
Set Data1 = CurrentDb
If MsgBox("Start new analysis Session?", vbYesNo) = vbYes Then
DeleteTables "Well Curve Data"
S1 = "Create Table [Well Curve Data] (ID COUNTER CONSTRAINT PrimaryKey PRIMARY KEY, [FPath] text(255),[String Group 1] text(255),[String Group 2] text(255),[Assay Name] text(255),[Assay Name Root] text(255),[Well Position] text(255), [Observed Call] text(255), [Orientation] text(255),[Instrument] text(255),[Flagged] Text(255), [TS] text(255),[General Comments] text(255))"
Data1.Execute S1
DoCmd.OpenForm "Import Well Curve Files"
Else
rs1.Open "Select [FPath] From [Well Curve Data]", DBConnection, dOpenStatic, adLockOptimistic
If rs1.BOF And rs1.EOF Then
MsgBox "'Well curve analysis' table is empty.", vbInformation
Exit Sub
End If
For i = 1 To rs1.RecordCount
If FileOrDirExists(rs1.Fields("FPath").Value) = False Then
Msgbox "One or more well curve files have been moved.", vbInformation
GoTo Bypass1:
Else
rs1.MoveNext
End If
Next i
End If
DoCmd.OpenForm "Well Curve Analysis"
Bypass1:
Exit Sub
End Sub
The function below was copied from (
Function FileOrDirExists(PathName As String) As Boolean
'Macro Purpose: Function returns TRUE if the specified file
' or folder exists, false if not.
'PathName : Supports Windows mapped drives or UNC
' : Supports Macintosh paths
'File usage : Provide full file path and extension
'Folder usage : Provide full folder path
' Accepts with/without trailing "\" (Windows)
' Accepts with/without trailing ":" (Macintosh)
Dim iTemp As Integer
'Ignore errors to allow for error evaluation
On Error Resume Next
iTemp = GetAttr(PathName)
'Check if error exists and set response appropriately
Select Case Err.Number
Case Is = 0
FileOrDirExists = True
Case Else
FileOrDirExists = False
End Select
'Resume error checking
On Error GoTo 0
End Function
