How to have a function write code to a report module. 1

[Shamous]

What I am trying to do is insert a function call into a series of reports that have been already designed. Lets say that I have 500 reports. I don't want to open each one and paste the call into each Report_module.

Is there any easy way to open the report and be able to get at the module area, and then insert this string in there?

Any help is appreciated.

Thanks

Rusty

 

[VBslammer]

The answer is yes, but you have to use a library database to do it. The procedures that allow you to write new text in a module cause your entire project to reset its variables (see Microsoft KB Article - Q198637).

However, a library database is nothing more than a regular Access database renamed with a .mda extension. Then, you register your library database just like you would an activeX control by browsing for it from the IDE's menu 'Tools-->References' dialog.

Once registered, you can call its global methods just like they reside in the local database.

That said, here's a function you can place in a library database (in a standard module) that will append code to report modules:

'********************
'*  §lamKeys §oftware 2000® (mailto: slamkeys@ev1.net)
'*
'*  @CREATED  :   10/29/2002 9:56:11 PM
'*  @PARAMS   :   strCode - formatted code string.
'*                skipSubs - True skips reports with "sub" in name.
'*                reportNames() - Optional report names. If empty, will
'*                process all reports.
'*  @RETURNS  :   True if successful.
'*  @NOTES    :
'*  @MODIFIED :
'********************
Function AddCodeToReports(ByVal strCode As String, _
                          ByVal skipSubs As Boolean, _
                          ParamArray reportNames() As Variant) As Boolean
On Error GoTo ErrHandler
  Dim accObj          As AccessObject
  Dim rpt             As Report
  Dim mdl             As Module
  Dim intTtl          As Integer
  Dim intCtr          As Integer
  Dim blnMatch        As Boolean
  
  ' If code is empty - abort.
  If Len(strCode) = 0 Then GoTo ExitHere
  
  intTtl = UBound(reportNames)
  
  For Each accObj In CurrentProject.AllReports
  
    ' Init flag.
    blnMatch = False
    
    ' Check for match.
    If (intTtl = -1) Then   ' process all if missing param.
      blnMatch = True
    ElseIf accObj.Name = reportNames(intCtr) Then    'check reports by name.
      ' handle subreport skipping (must have "sub" in report name).
      If Not skipSubs Then
        blnMatch = True
      Else
        If InStr(UCase(accObj.Name), "SUB") = 0 Then
          blnMatch = True
        End If
      End If
    End If

    If blnMatch Then
      
      ' turn off screen updating.
      DoCmd.Echo False
      
      ' Open in design view - not available in runtime version.
      DoCmd.OpenReport accObj.Name, acViewDesign
      
      ' assign object reference.
      Set rpt = Reports(accObj.Name)
      
      ' check module status.
      If rpt.HasModule = False Then
        rpt.HasModule = True
      End If
      
      ' assign module reference.
      Set mdl = rpt.Module
      
      ' append the code string.
      mdl.InsertText vbCrLf & "'@ Auto-coded " & Date & vbCrLf & strCode
      
      ' close and save.
      DoCmd.Close acReport, rpt.Name, acSaveYes
      
    End If
    
  Next accObj
    
  AddCodeToReports = True
  
ExitHere:
  ' make sure screen updating is back on
  DoCmd.Echo True
  Exit Function
ErrHandler:
  MsgBox "Error: " & Err & " - " & Err.Description
  Resume ExitHere
End Function

'@--------------------------------------------------------@

Here is a sample call that could be attached to a button or menu item:

Function TestReportCoder()
  Dim strCode As String
  
  strCode = "Function myFunction()" & vbCrLf
  strCode = strCode & Chr(9) & "MsgBox " & Chr(34) & "Hello World" & Chr(34) & vbCrLf
  strCode = strCode & "End Function" & vbCrLf
  
  If AddCodeToReports(strCode, True) = True Then
    MsgBox "Code successfully added to reports", vbInformation, "Success"
  Else
    MsgBox "Code not successfully added to reports", vbCritical, "Error"
  End If
  
End Function

'@--------------------------------------------------------@

The resulting code from this simple sample looks like this:

'@ Auto-coded 10/29/2002
Function myFunction()
  MsgBox "Hello World"
End Function

Additional comments: This procedure appends the code to the end of the module. You can also modify the code to insert text anywhere in the module using other methods (mdl.InsertLines, mdl.CreateEventProc, etc.)

If you want to attach code to a specific built-in event, you may also have to set the event property for the control to "[Event Procedure]" like this:

Dim rpt As Report

Set rpt = Reports("MyReport")
rpt.OnPage = "[Event Procedure]"

or to call your custom function:

rpt.OnPage = "=MyCustomFunction()"

VBSlammer

Unemployed in Houston, Texas

 

[MichaelRed]

VBSlammer
Unemployed in Houston, Texas



Welcome to the Club, I've been here WAY to long!

My family thinks I'v graduated to emeritus of all possible positions.
MichaelRed
m.red@att.net

Searching for employment in all the wrong places

 

[Shamous]

thanks, looks good, but I keep getting "User Defined type - not defined" error in the mda lib that I created following your example.

Here is how I called it.

Function TestReportCoder()
Dim strCode As String

strCode = "Call AddToUseLog(strObjectName As String)"

If AddCodeToReports(strCode, True, "MyReport&quot Then
Msgbox "Code successfully added to reports", vbInformation, "Success"
Else
Msgbox "Code not successfully added to reports", vbCritical, "Error"
End If

End Function

Then I just go to debug and type ?TestReportCoder()

Thats when I get the error.

Any ideas?

thanks

Rusty

 

[MichaelRed]

Using the same function name may help:

strCode = "Call AddToUseLog(strObjectName As String)"

If AddCodeToReports(strCode, True, "MyReport&quot Then



MichaelRed
m.red@att.net

Searching for employment in all the wrong places

 

[MichaelRed]

5-0-0 Reports?

Sounds to ME like you need some SERIOUS help in redesigning this app. I cannot believe that many of them are ever so minimal a variation that they cannot (read should not) be collapsed into MANY fewer with some parameterization.

I did this at ONE company, reducing over 200 reports to ~ 25 AND increased the flexability of the package. Having that many reports takes maintenance from an onorous 'chore' and places it in the realm of a nighmare. I would be interested (from the analyst perspective) of knowing how many users you have on this (average, max) and the frequency of usage of the individual reports. It would be a useful analylitical effort to just instantiate each report and see if they all still "Work". Again, I am going to guess that many will not - one clue to the real soloution - redesign.

Given the improbable number of reports, I would also speculate that the number of queries is way larger than you can keep track of -and updated to reflect the datbase schems, so another fertile field is available for the re-design effort.


MichaelRed
m.red@att.net

Searching for employment in all the wrong places

 

[Shamous]

Believe me thats what I am doing. The code I want to place in all of these reports is a loging function which logs when and who used the report. If in the next 6 weeks no one uses the reports and its not one of mine, ITS GONE and so is the query.

But, If I just start deleting 8 yrs of Reports from the application my CEO will hang me from the highest rafter. I have to be sure that its not currently being used by anyone but MIS.

Back to the code. The string "Call AddToUseLog strObjectName As String)" IS the code I need to add to each report.

Therefore, AddCodeToReports(strCode, True, "MyReport&quot should work where strcode contains the code, 'True' indicatates to skip if a subreport, and "MyReport" is the name of the report I want to rip into and add that line.

I must be dense, since I still not sure what your referring to.

 

[VBslammer]

It sounds like you need to add your function call to the 'Report_Open()' event to make this work. Here is an additional snippet that finds the Report_Open() event, and if it's not there it adds it, then adds your function call inside it's code block:

  'Additional variables
  Dim lngProcLine     As Long
  
  Const VB_PROC = 0   ' value of extensiblity constant vbext_pk_Proc
      

      ' ...existing code body...

      ' assign module reference.
      Set mdl = rpt.Module
      
      '@---------- below added -------------@
      
      ' Find report's Open() event.
      On Error Resume Next
      lngProcLine = mdl.ProcBodyLine("Report_Open", VB_PROC)
      
      ' If not found - add it.
      If Err <> 0 Then
        Err.Clear
        On Error Goto ErrHandler
        mdl.InsertText &quot;Public Sub Report_Open(Cancel As Integer)&quot;
        mdl.InsertText &quot;'@ Auto-coded &quot; & Date & vbCrLf & strCode
        mdl.InsertText &quot;End Sub&quot;
      Else
        ' found it, just insert code.
        On Error Goto ErrHandler
        mdl.InsertLines lngProcLine + 1, _
          &quot;'@ Auto-coded &quot; & Date & vbCrLf & strCode
      End If
      
      '@----------- above added ------------@

      ' close and save.
      DoCmd.Close acReport, rpt.Name, acSaveYes

      '...continued code...

VBSlammer

Unemployed in Houston, Texas

 

[VBslammer]

You also need to change the function call to include the report name (and date & time?) like this:

strCode = _
   "Call AddToUseLog(Me.Name, Date & Space(2) & Format(Now, " & Chr(34) & "Long Time" & Chr(34) & "))"

Which yields:

Call AddToUseLog(Me.Name, Date & Space(2) & Format(Now, "Long Time"))

Also note that once you get it tested on a single report, you can omit the report name from the function call to process all reports.


Warning - if your subreports do not contain "sub" in their names then they will be processed as well.

As far as the error, check the references to see which library is missing. Are you using Access 2000? If you're using Access 97 the AccessObject will be undefined because it was added in Access 2000. If that's the problem let me know and I'll change the code to work in '97.
VBSlammer

Unemployed in Houston, Texas

 

[Shamous]

yep thats it. This code was written for 2000 not 97. I am using 97. Is there a work around?

 

[VBslammer]

Change the beginning of the function to this:

Function AddCodeToReports97(ByVal strCode As String, _
                          ByVal skipSubs As Boolean, _
                          ParamArray reportNames() As Variant) As Boolean
On Error GoTo ErrHandler
  Dim db              As DAO.Database
  Dim accObj          As DAO.Document
  Dim rpt             As Report
  Dim mdl             As Module
  Dim intTtl          As Integer
  Dim intCtr          As Integer
  Dim blnMatch        As Boolean
  Dim lngProcLine     As Long
  
  Const VB_PROC = 0   ' value of extensiblity constant vbext_pk_Proc
  
  ' If code is empty - abort.
  If Len(strCode) = 0 Then GoTo ExitHere
  
  intTtl = UBound(reportNames)
  
  Set db = Workspaces(0).Databases(0)
  
  For Each accObj In db.Containers![Reports].Documents

  '@-------------- the rest is the same ------------@

I don't have a '97 machine running but I think this will work based on my past experience with Access 97. Let us know.
VBSlammer

Unemployed in Houston, Texas

 

[Shamous]

thank you for all of the help. In your experience, did you ever migrate 97 apps to 2000 apps or just start anew. Or did you just leave well enough alone?

-Rusty

 

[Shamous]

ok, here what happen. When I tried it after making all of your additions. It worked - sort of. It put the code in full and accurately - outside the "End Sub". Here is the final code I made into a library.

Function AddCodeToReports97(ByVal strCode As String, _
ByVal skipSubs As Boolean, _
ParamArray reportNames() As Variant) As Boolean
On Error GoTo ErrHandler
Dim db As DAO.Database
Dim accObj As DAO.Document
Dim rpt As Report
Dim mdl As Module
Dim intTtl As Integer
Dim intCtr As Integer
Dim blnMatch As Boolean
Dim lngProcLine As Long

Const VB_PROC = 0 ' value of extensiblity constant vbext_pk_Proc

' If code is empty - abort.
If Len(strCode) = 0 Then GoTo ExitHere

intTtl = UBound(reportNames)

Set db = Workspaces(0).Databases(0)

For Each accObj In db.Containers![Reports].Documents

' Init flag.
blnMatch = False

' Check for match.
If (intTtl = -1) Then ' process all if missing param.
blnMatch = True
ElseIf accObj.Name = reportNames(intCtr) Then 'check reports by name.
' handle subreport skipping (must have "sub" in report name).
If Not skipSubs Then
blnMatch = True
Else
If InStr(UCase(accObj.Name), "SUB&quot = 0 Then
blnMatch = True
End If
End If
End If

If blnMatch Then

' turn off screen updating.
DoCmd.Echo False

' Open in design view - not available in runtime version.
DoCmd.OpenReport accObj.Name, acViewDesign

' assign object reference.
Set rpt = Reports(accObj.Name)

' check module status.
If rpt.HasModule = False Then
rpt.HasModule = True
End If

' assign module reference.
Set mdl = rpt.Module

' Find report's Open() event.
On Error Resume Next
lngProcLine = mdl.ProcBodyLine("Report_Open", VB_PROC)

' If not found - add it.
If Err <> 0 Then
Err.Clear
On Error GoTo ErrHandler
mdl.InsertText &quot;Public Sub Report_Open(Cancel As Integer)&quot;
mdl.InsertText &quot;'@ Auto-coded &quot; & Date & vbCrLf & strCode
mdl.InsertText &quot;End Sub&quot;
Else
' found it, just insert code.
On Error GoTo ErrHandler
mdl.InsertLines lngProcLine + 1, _
&quot;'@ Auto-coded &quot; & Date & vbCrLf & strCode
End If

' close and save.
DoCmd.Close acReport, rpt.Name, acSaveYes

End If

Next accObj

AddCodeToReports97 = True

ExitHere:
' make sure screen updating is back on
DoCmd.Echo True
Exit Function
ErrHandler:
MsgBox &quot;Error: &quot; & Err & &quot; - &quot; & Err.Description
Resume ExitHere
End Function

 

[VBslammer]

Yes I've migrated without too many problems. The majority of errors result from the switch from DAO to ADO. Normally all you have to do is set a reference to the DAO Object library after the conversion and use explicit references to any DAO code that chokes the compiler, for example:

Dim prp As Property

becomes

Dim prp As DAO.Property

For me, Access 2000 is easier to work with because it has the familiar VBA Editor instead of the SDI window editor (which I can't stand) and also allows us to raise events from our class modules which was not possible in '97.

I did encounter some bugs with Access 2000 (display anomalies) that were resolved by the SR-1 update, as well as some bugs that were introduced by the update (SendObject crashing Access if Message text added programmatically).

The biggest con I've heard against Access 2000 is the size of the footprint when you distribute it. Access 97 is considerably more compact and loads faster as well.



VBSlammer

Unemployed in Houston, Texas

 

[Shamous]

have you been out of work long. goto

http://www.payquake.com

if you want to see what we do. we compete with PayPal. Go to paypalsucks.com to see what they do or don't do. (I didn't make that site up. It has been there a long time)

 

[VBslammer]

I fired up my 97 box and tried the code. The only hiccup I got was:

Set db = Workspaces(0).Databases(0)

didn't run so I changed it to:

Set db = CurrentDb

...and it worked OK - all the code was inserted inside the function as it should. The 'mdl.procBodyLine()' method returns the line that the function declaration is on so mdl.procBodyLine() + 1 should fall within the function.

VBSlammer

Unemployed in Houston, Texas

 

[MichaelRed]

An approach I have used to 'clean-up' a db is a compromise between the re-design and clean out the old.

I review the app for it's intended functionality, and do a re-design on the BASIC requirements. This is presented to the User community and distribuited for formal comment. Comments are reviewed and incorporated after discussion / resoloution. A working prototype is generated according to the revised (BASIC) design requirements and tested by a FEW Users. Bugs are posted and fixed. The &quot;New&quot; app is distribuited for use, and the old app is moved / re-named to 'encourage' the migration. As Users discover functionality and informaiton which they need, they submit (FORMAL) change requests, which are then processed. Approved change requests are incorporated. The 'Old' app is retained to provide a reference / repository of previous functionality.

Like your approach, I did a code trace of the old app, logging the objects which were actually used - down to the procedure level for code and just the form / report level for the remaining object types (except MRCOs - as these were all converted to CODE prior to any of the above. Review of the trace log also revealed several to many instances where re-arrangement (optimization) yielded significant improvement in the overall app performance. Primarily, this was just the old concentrate on the routines which are most frequently visited, but it also revealed other issues, such as routines which repeatedly called a procedure to re-calculate a value which could have just been saved from the first call - one particular instance of this created ~~ 25 calls to its' set of subs each time it was called - and the calling function was called at least once for every report generated by the app.

MichaelRed
m.red@att.net

Searching for employment in all the wrong places