Create A New Class Module
acCmdNewObjectClassModule
Example of creating a class module from code.
'***************** Code Start *******************
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
Function ClassWiz_fRetNewClassModule() As Access.Module
Dim mdl As Access.Module
Dim rs As DAO.Recordset, db As DAO.Database
Dim i As Integer, stName As String
Const ERR_CLOSEALLMODULES = vbObjectError + 10
On Local Error GoTo ClassWiz_fRetNewClassModule_Err
Dim msg As String ' for error handling
msg = "The Class Wizard must close all open modules before proceeding." & vbCrLf
msg = msg & "Any changes in currently open modules will be automatically saved." & vbCrLf
msg = msg & "Ok to continue?"
If MsgBox(msg, vbQuestion + vbOKCancel, "Please confirm") <> vbOK _
Then Err.Raise ERR_CLOSEALLMODULES
'store the names of all current open modules
ReDim Preserve mastMod(Modules.Count)
For i = Modules.Count - 1 To 0 Step -1
Set mdl = Modules(i)
mastMod(i) = mdl.Name
DoCmd.Close acModule, mastMod(i), acSaveYes
Next
DoCmd.SelectObject acModule, , True
DoCmd.RunCommand acCmdNewObjectClassModule
Set db = Access.CodeDb
Set rs = db.OpenRecordset("tblClass", dbOpenSnapshot)
'now we must check Modules again to get the first item in collection.
'make sure we're picking the last opened module
Set mdl = Modules(Modules.Count - 1)
'Insert a bogus line so that we can close the module; BIG BAD BUG ?!?
mdl.InsertLines 3, "'Created on: " & Now()
mdl.InsertLines 4, "'By: " & ClassWiz_fOSUserName()
stName = mdl.Name
'ok we have the new module created
'now let's close it and then apply the Rename Method (which you forgot you Dum Dum!!)
DoCmd.Close acModule, stName, acSaveYes
DoCmd.SelectObject acModule, stName, True
DoCmd.Rename rs!ClassName, acModule, stName
DoCmd.OpenModule rs!ClassName
Set ClassWiz_fRetNewClassModule = Modules(Modules.Count - 1)
ClassWiz_fRetNewClassModule_End:
On Error Resume Next
Set mdl = Nothing
Set rs = Nothing
Set db = Nothing
Exit Function
ClassWiz_fRetNewClassModule_Err:
MsgBox Err.Number & vbCrLf & Err.Description
Set ClassWiz_fRetNewClassModule = Nothing
If Err <> ERR_CLOSEALLMODULES Then
msg = "Error Information..." & vbCrLf & vbCrLf
msg = msg & "Description: " & Err.Description & vbCrLf
msg = msg & "Error #: " & Err.Number & vbCrLf
MsgBox msg, vbInformation, "ClassWiz_sCreateModule"
Resume ClassWiz_fRetNewClassModule_End
End If
End Function
'****************** Code End ********************
