G
gr
Hi, I moved my database from one directory to another
(back and front end) there I opened the front end, refresh
links and made de MDE.
Icopy paste the MDE to my local drive, and the database
was not working anymore... =(
Data was lost during navigation. I came back to the frond
end mdb and even without having any break code was break
during execution.
I returned the database to its original folder, refresh
again links but things are still the same.
Everything seems to work fine, but this code which used to
work is giving me know trouble.
Private Sub cmdGoChooseArea_Click()
On Error GoTo SubError
If IsNull(Me!txtboxDate) Then
MsgBox "Please type a Date!", vbCritical, "Warning"
Exit Sub
End If
Dim gNameID As Long
Dim intOpcion As Integer
Dim strSQL As String
gNameID = CreateRecordset()
strSQL = "NameID Like " & gNameID
intOpcion = Me!OgAreas
DoCmd.OpenForm "frmName", acNormal, , strSQL
Select Case intOpcion
Case 1
'Administration & Others
Forms!frmName!sfrmAreas.SourceObject = "sfrmAdmin"
Forms!frmName!LblTitle.Caption = "Administration
and Others"
Forms!frmName!txtSumAdmin.Visible = True
Case 2
'Projects
Forms!frmName!sfrmAreas.SourceObject
= "sfrmProjects"
Forms!frmName!LblTitle.Caption = "Projects"
Forms!frmName!txtSumProjects.Visible = True
Case 3
'Sales Support
Forms!frmName!sfrmAreas.SourceObject = "sfrmSales"
Forms!frmName!LblTitle.Caption = "Sales Support"
Forms!frmName!txtSumSales.Visible = True
Case 4
'Service
Forms!frmName!sfrmAreas.SourceObject
= "sfrmService"
Forms!frmName!LblTitle.Caption = "Service"
Forms!frmName!txtSumService.Visible = True
End Select
DoCmd.Close acForm, "frmChooseArea"
Salir_Sub:
Exit Sub
SubError:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Salir_Sub
End Sub
Function CreateRecordset() As Long
On Error GoTo CreateRecordsetErr
DoCmd.Hourglass True
Dim cnn As ADODB.Connection
Dim cat As ADOX.Catalog
Dim cmd As ADODB.Command
Dim rstData As ADODB.Recordset
Dim rstName As ADODB.Recordset
Dim param1 As ADODB.Parameter
Dim param2 As ADODB.Parameter
Dim strParam1 As String
Dim strParam2 As String
'Set cat = New adox.catalog
'cat.ActiveConnection = CurrentProject.Connection
Set cnn = New ADODB.Connection
cnn.Open CurrentProject.Connection
Set cat = New ADOX.Catalog
cat.ActiveConnection = cnn
Set cmd = cat.Procedures("qryTimeRecording").Command
Set rstName = New ADODB.Recordset
rstName.ActiveConnection = cnn
rstName.CursorType = adOpenDynamic
rstName.LockType = adLockOptimistic
If Not (cmd Is Nothing) Then
cmd.Parameters("[Forms]![frmChooseArea].[Form]!
[txtboxName]").Value = [Forms]![frmChooseArea].[Form]!
[txtboxName]
cmd.Parameters("[Forms]![frmChooseArea].[Form]!
[txtboxDate]").Value = [Forms]![frmChooseArea].[Form]!
[txtboxDate]
Set rstData = cmd.Execute(Options:=adCmdTable)
If (rstData.BOF And rstData.EOF) Then
rstName.Open "tblName"
With rstName
.AddNew
!Names = Me!txtboxName
!Dt = Me!txtboxDate
.Update
CreateRecordset = !NameID
End With
rstName.Close
Set rstName = Nothing
Else
CreateRecordset = rstData![NameID]
End If
End If
'MsgBox CreateRecordset
Salir_Fun:
rstData.Close
cnn.Close
Set cnn = Nothing
Set cmd = Nothing
Set rstData = Nothing
DoCmd.Hourglass False
Exit Function
CreateRecordsetErr:
DoCmd.Hourglass False
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Salir_Fun
End Function
(back and front end) there I opened the front end, refresh
links and made de MDE.
Icopy paste the MDE to my local drive, and the database
was not working anymore... =(
Data was lost during navigation. I came back to the frond
end mdb and even without having any break code was break
during execution.
I returned the database to its original folder, refresh
again links but things are still the same.
Everything seems to work fine, but this code which used to
work is giving me know trouble.
Private Sub cmdGoChooseArea_Click()
On Error GoTo SubError
If IsNull(Me!txtboxDate) Then
MsgBox "Please type a Date!", vbCritical, "Warning"
Exit Sub
End If
Dim gNameID As Long
Dim intOpcion As Integer
Dim strSQL As String
gNameID = CreateRecordset()
strSQL = "NameID Like " & gNameID
intOpcion = Me!OgAreas
DoCmd.OpenForm "frmName", acNormal, , strSQL
Select Case intOpcion
Case 1
'Administration & Others
Forms!frmName!sfrmAreas.SourceObject = "sfrmAdmin"
Forms!frmName!LblTitle.Caption = "Administration
and Others"
Forms!frmName!txtSumAdmin.Visible = True
Case 2
'Projects
Forms!frmName!sfrmAreas.SourceObject
= "sfrmProjects"
Forms!frmName!LblTitle.Caption = "Projects"
Forms!frmName!txtSumProjects.Visible = True
Case 3
'Sales Support
Forms!frmName!sfrmAreas.SourceObject = "sfrmSales"
Forms!frmName!LblTitle.Caption = "Sales Support"
Forms!frmName!txtSumSales.Visible = True
Case 4
'Service
Forms!frmName!sfrmAreas.SourceObject
= "sfrmService"
Forms!frmName!LblTitle.Caption = "Service"
Forms!frmName!txtSumService.Visible = True
End Select
DoCmd.Close acForm, "frmChooseArea"
Salir_Sub:
Exit Sub
SubError:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Salir_Sub
End Sub
Function CreateRecordset() As Long
On Error GoTo CreateRecordsetErr
DoCmd.Hourglass True
Dim cnn As ADODB.Connection
Dim cat As ADOX.Catalog
Dim cmd As ADODB.Command
Dim rstData As ADODB.Recordset
Dim rstName As ADODB.Recordset
Dim param1 As ADODB.Parameter
Dim param2 As ADODB.Parameter
Dim strParam1 As String
Dim strParam2 As String
'Set cat = New adox.catalog
'cat.ActiveConnection = CurrentProject.Connection
Set cnn = New ADODB.Connection
cnn.Open CurrentProject.Connection
Set cat = New ADOX.Catalog
cat.ActiveConnection = cnn
Set cmd = cat.Procedures("qryTimeRecording").Command
Set rstName = New ADODB.Recordset
rstName.ActiveConnection = cnn
rstName.CursorType = adOpenDynamic
rstName.LockType = adLockOptimistic
If Not (cmd Is Nothing) Then
cmd.Parameters("[Forms]![frmChooseArea].[Form]!
[txtboxName]").Value = [Forms]![frmChooseArea].[Form]!
[txtboxName]
cmd.Parameters("[Forms]![frmChooseArea].[Form]!
[txtboxDate]").Value = [Forms]![frmChooseArea].[Form]!
[txtboxDate]
Set rstData = cmd.Execute(Options:=adCmdTable)
If (rstData.BOF And rstData.EOF) Then
rstName.Open "tblName"
With rstName
.AddNew
!Names = Me!txtboxName
!Dt = Me!txtboxDate
.Update
CreateRecordset = !NameID
End With
rstName.Close
Set rstName = Nothing
Else
CreateRecordset = rstData![NameID]
End If
End If
'MsgBox CreateRecordset
Salir_Fun:
rstData.Close
cnn.Close
Set cnn = Nothing
Set cmd = Nothing
Set rstData = Nothing
DoCmd.Hourglass False
Exit Function
CreateRecordsetErr:
DoCmd.Hourglass False
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Salir_Fun
End Function