ACCESS FEED: Re: [MS_AccessPros] Re: VBA Issue with looping through recordset

Bill,

Still struggling with this issue. Your code was out of my league. I tried to get it working but it was just was a mess after I botched it up. I think that my issue is that I have lines of code in the wrong place.

Jim Wagner

On Friday, July 11, 2014 2:34 PM, "wrmosca@comcast.net [MS_Access_Professionals]" <MS_Access_Professionals@yahoogroups.com> wrote:

Jim

I had a report that I had to output as HTML. I worked around the crazy way that Access does it by using DoCmd.OutputTo . It's a big work-around but it works. You don't get all those extra files and the format looks pretty much like the report.

I end up storing the cleaned up HTML as a memo in a table and then sending out that memo field as the "report", but you could just save the memo as a text file with an HTML file extension.

Here is my entire routine. Let me know if you need help with it.

BE SURE TO ADD MS Scripting Runtime TO YOUR CODE REFERENCES.

Public Function RptToHTML(strRptFile, datMidnight As Date, strEntityID As String)

'Purpose : Save report as HTML for email.

'DateTime : 3/25/2013 07:52

'Author : Bill Mosca

'Requires : MS Scripting Runtime

Dim strHTML As String

Dim intFile As Integer

Dim fso As FileSystemObject

Dim f As TextStream

Dim fldr As Folder

Dim strFolderPath As String

Const ForReading = 1

Const ForWriting = 2

Dim strLine As String

Dim i As Long

Dim strFilePath As String

Dim intpages As Integer

If gbolErrorTrapOff = False Then On Error GoTo err_PROC

'Delete record if it exists.

CurrentDb.Execute "DELETE FROM tblStatDailyCensusHTML " _

& "WHERE DateCensus = #" & datMidnight & "# " _

& "AND EntityID = '" & strEntityID & "'", dbSeeChanges

Set fso = CreateObject("Scripting.FileSystemObject")

strFolderPath = Environ("TEMP") & "\FRS_Temp"

'Delete folder if it exists so all files are removed.

If fso.FolderExists(strFolderPath) Then

fso.DeleteFolder strFolderPath, True

End If

fso.CreateFolder strFolderPath

Set fldr = fso.GetFolder(strFolderPath)

strFilePath = fldr.path & "\DailyCensus_" & Format(datMidnight, "yyyymmdd") & ".html"

DoCmd.OutputTo acOutputReport, strRptFile, acFormatHTML, strFilePath

Set f = fso.OpenTextFile(strFilePath, ForReading)

strHTML = f.ReadAll

'Clean up quotes and nul character at end of HTML

' strHTML = Replace(Replace(Replace(strHTML, """", """"""), vbNewLine, ""), vbNullChar, "")

strHTML = Replace(Replace(strHTML, vbNewLine, ""), vbNullChar, "")

CurrentDb.Execute "INSERT INTO tblStatDailyCensusHTML(DateCensus, CensusHTML, EntityID) " _

& "Values(#" & datMidnight & "#,'" & strHTML & "', '" & strEntityID & "')", dbSeeChanges

exit_PROC:

On Error Resume Next

Set f = Nothing

Set fldr = Nothing

Set fso = Nothing

Exit Function

err_PROC:

Dim strErrMsg As String

Dim lngIcon As Long

Select Case Err.Number

Case 2501

'Open cancelled.

strErrMsg = "No information for selected filter."

lngIcon = vbOKOnly + vbInformation

Case Else

gProcName = "RptToHTML"

glngErrNum = Err.Number

gstrErrDescr = Err.Description

glngLineNum = Erl

Call ErrorLog("basDailyCensusEmail")

End Select

If strErrMsg <> "" Then MsgBox strErrMsg, lngIcon, _

GetSummaryInfo("Title", False)

Resume exit_PROC

End Function

Bill Mosca

---In MS_Access_Professionals@yahoogroups.com, <luvmymelody@yahoo.com> wrote :

Hello all,

I have a procedure that I would like to work correctly. I would like the code to loop through the recordset and store the report in a folder as an html document. For the least part, the code does loop through the recordset and outputs the report as an html by the name of the contact person. The issue is that the output is crazy. The output folder contains the 143 reports but the output folder stores them as below.

John Brown.html

John BrownPage1.html

John BrownPage2.html

John BrownPage3.html

continues to page 143 then starts at the next persons name and continues the pattern with the first name.

The html report shows the report and then has navigational buttons such as below

First Previous Next Last

which does navigate between each of the contact names even though the name of the html document is the first persons name.

I think that there is a line out or in the loop incorrectly. There are some commented lines because I have been trying all kinds of things in the developing version.

Thank You for any help.

Private Sub cmdEmissionsVPOCValidation_Click()

' This process generates the reports for the vehicle's which have their emissions due on the date given by the user on the main form and sends

' report for the vpoc validation email.

Dim RS_1 As DAO.Recordset

Dim db As DAO.Database

Dim strSQL As String

Dim sSQL As String

Dim NoReports As Integer

' It may happen that for a given time period, there may be no verhicles with emissions due. In that case, no emails will be sent out.

' This may lead to a blank screen. To help the user understand, we use the flag NoReports. It is set to 1 initially, and cleared to 0 when a vehicle is due emission.

' At the end of the email process, this flag is checked. If this flag is set to 1, it means that there was not a single report that was emailed out and therefore the user is

' suitably informed.

NoReports = 1

Set db = CurrentDb

' Select distinct [Contact Name] from the VehicleEmissions table

' The file name of the report is the name of Point of Contact.html

' Disable all warnings

DoCmd.SetWarnings False

' When the data is imported from the CMMS webpage, there may be some records that have [Next Emissions Test Date] field empty in the VehicleEmissions table.

' These records must be deleted as the emissions date cannot be tested for these records.

' The following query deletes all records from VehicleEmissions that have the [Next Emissions Test Date] set to 'Null'

'DoCmd.OpenQuery "qry_Del Null Next Emissions Dt"

strSQL = "SELECT DISTINCT [Contact Name] FROM VehiclesWithEmission"

Set RS_1 = db.OpenRecordset(strSQL, dbOpenDynaset)

RS_1.MoveFirst

' Delete existing reports before generating new ones

' a is just a dummy variable

a = DeleteReports()

'gg

' myPath stores the path of the directory which stores the outputted reports

myPath = "S:\Fleet Services Reporting\Outputted Reports\VPOC Validation\"

' For all the distinct [Contact Name] in table VehicleEmissions

Do While Not RS_1.EOF

' Extract the Contact name

Contact = RS_1![Contact Name]

' Obtain all records from qryVehicleEmissionsDueReport, for the given Contact Name and records that have next emissions due on or before the date entered on the Main Switchboard

'sSQL = "SELECT * FROM qryVehicleEmissionsDueReport Where (((qryVehicleEmissionsDueReport.[Contact Name])))= """ & "" & [Contact]

'sSQL = "SELECT * FROM VehiclesWithEmission Where ((VehiclesWithEmission.[Contact Name]))= """ & "" & [Contact] Is Not Null

sSQL = "SELECT * FROM VehiclesWithEmission Where VehiclesWithEmission.[Contact Name]= """ & "" & [Contact] & "" & """"

' Obtain the number of records resulting from the above SQL Query

Set RS_2 = db.OpenRecordset(sSQL)

' If records exist, i.e, if there are any vehicles belonging to the [Contact Name], that have their emissions due,

If RS_2.RecordCount <> 0 Then

' Clear the flag, since we have at least one vehicle due its emissions

NoReports = 0

' Open the report to be emailed

DoCmd.OpenReport "rptVehiicleEmissionsDataRequestVPOCValidationForHTML", acViewReport

' The above report is the entire report - for all contacts and vehicles

' We would like to select only the records belonging to the [Contact Name] that have their emissions due

' Therefore, we change the source of the report by the query - sSQL - as defined below

' Select the "Email Body" (editable by user) and all other required fields from the VehicleEmissionDueReport for the given [Contact Name] and Emissions due date

' This statement sets the criteria as mentioned above

sSQL = "SELECT tblVehicleSurveyAnnouncementEmailBody.[Vehicle Survey Email Body], * FROM VehiclesWithEmission, tblVehicleSurveyAnnouncementEmailBody Where (((VehiclesWithEmission.[Contact Name])=""" & "" & [Contact] & """" & ")"

' This statement sets the record source to the criteria

Reports.Item("rptVehiicleEmissionsDataRequestVPOCValidationForHTML").RecordSource = sSQL ' which is a report

' Save the Report as .html at myPath with a file name of the [Contact Name]

' We also append the '.html' file extension at the end of the file name

DoCmd.OutputTo acOutputReport, "rptVehiicleEmissionsDataRequestVPOCValidationForHTML", acFormatHTML, myPath & Contact & ".html", False

' Close the Report

DoCmd.Close acReport, "rptVehiicleEmissionsDataRequestVPOCValidationForHTML" 'which is a report

End If

' Process the next record

RS_1.MoveNext

Loop

DoCmd.SetWarnings True