A
AG
Hi all,
I need to change the background color of all forms in an Access 2000
application using automation from another application.
The following works on most forms, but on some, I receive the error 2046 -
The command or action 'OpenForm' isn't available now.
The error occurs on the line appAccess.DoCmd.OpenForm strFrm, acDesign.
If I set the application to visible, I can break in the code and open the
form in design view manually, with no error.
I doubt it is a corruption issue, because I exported one of the offending
forms as text and re-imported it.
If I run similar code (not needing to createobject) from within the
application, it runs fine.
Does anyone have any ideas as to the cause (and solution) for the error?
Public Function StyleDestDb(ByVal strDestFile As String) As Boolean
Dim appAccess As Access.Application
Dim dbS As Access.CodeProject
Dim obJ As Access.AccessObject
Dim strFrm As String
Dim frM As Access.Form
Dim arObj() As String
Dim intCnt As Integer
Dim intIdx As Integer
On Error GoTo ErrLine
Set appAccess = CreateObject("Access.Application")
appAccess.OpenCurrentDatabase filePath:=strDestFile, Exclusive:=True
Set dbS = appAccess.CurrentProject
intCnt = dbS.AllForms.count
If intCnt > 0 Then
ReDim arObj(intCnt - 1)
For Each obJ In dbS.AllForms
arObj(intIdx) = obJ.Name
intIdx = intIdx + 1
Next
Set obJ = Nothing
For intIdx = 0 To intCnt - 1
strFrm = arObj(intIdx)
appAccess.DoCmd.OpenForm strFrm, acDesign
DoEvents
Set frM = appAccess.Forms(strFrm)
frM.Section(acHeader).BackColor = conFormBackcolor
frM.Section(acDetail).BackColor = conFormBackcolor
frM.Section(acFooter).BackColor = conFormBackcolor
appAccess.DoCmd.Close acForm, strFrm, acSaveYes
DoEvents
Next
End If
StyleDestDb = True
ExitLine:
On Error Resume Next
Set frM = Nothing
Set obJ = Nothing
Set dbS = Nothing
appAccess.CloseCurrentDatabase
Set appAccess = Nothing
Exit Function
ErrLine:
If Err.Number = 2462 Then 'section number is invalid
Resume Next
Else
Call ReportError("StyleDestDb", strFrm) 'global error reporting
function
End If
Resume ExitLine
End Function
I need to change the background color of all forms in an Access 2000
application using automation from another application.
The following works on most forms, but on some, I receive the error 2046 -
The command or action 'OpenForm' isn't available now.
The error occurs on the line appAccess.DoCmd.OpenForm strFrm, acDesign.
If I set the application to visible, I can break in the code and open the
form in design view manually, with no error.
I doubt it is a corruption issue, because I exported one of the offending
forms as text and re-imported it.
If I run similar code (not needing to createobject) from within the
application, it runs fine.
Does anyone have any ideas as to the cause (and solution) for the error?
Public Function StyleDestDb(ByVal strDestFile As String) As Boolean
Dim appAccess As Access.Application
Dim dbS As Access.CodeProject
Dim obJ As Access.AccessObject
Dim strFrm As String
Dim frM As Access.Form
Dim arObj() As String
Dim intCnt As Integer
Dim intIdx As Integer
On Error GoTo ErrLine
Set appAccess = CreateObject("Access.Application")
appAccess.OpenCurrentDatabase filePath:=strDestFile, Exclusive:=True
Set dbS = appAccess.CurrentProject
intCnt = dbS.AllForms.count
If intCnt > 0 Then
ReDim arObj(intCnt - 1)
For Each obJ In dbS.AllForms
arObj(intIdx) = obJ.Name
intIdx = intIdx + 1
Next
Set obJ = Nothing
For intIdx = 0 To intCnt - 1
strFrm = arObj(intIdx)
appAccess.DoCmd.OpenForm strFrm, acDesign
DoEvents
Set frM = appAccess.Forms(strFrm)
frM.Section(acHeader).BackColor = conFormBackcolor
frM.Section(acDetail).BackColor = conFormBackcolor
frM.Section(acFooter).BackColor = conFormBackcolor
appAccess.DoCmd.Close acForm, strFrm, acSaveYes
DoEvents
Next
End If
StyleDestDb = True
ExitLine:
On Error Resume Next
Set frM = Nothing
Set obJ = Nothing
Set dbS = Nothing
appAccess.CloseCurrentDatabase
Set appAccess = Nothing
Exit Function
ErrLine:
If Err.Number = 2462 Then 'section number is invalid
Resume Next
Else
Call ReportError("StyleDestDb", strFrm) 'global error reporting
function
End If
Resume ExitLine
End Function