实现Access 2007“HTML报告”的更好方法

时间:2011-01-24 20:04:56

标签: html ms-access

我需要制作一个“静态html”类似FAQ的文档,供项目内部使用。

我将Access 2007数据库中的所有项目作为记录(问题,答案,类别),然后构建一个报告,使用子报告创建内容链接作为内部链接,然后列出所有问题和答案。这个报告是一堆带有动态生成的html代码的文本区域(显然我没有足够的信心来发布图像,所以http://i115.photobucket.com/albums/n299/SinbadEV/ReportCapture.png)...我只是将报告导出到文本文件然后重命名到.html并在浏览器中打开它。

我认为必须有一种不那么邪恶的方式来做到这一点。

5 个答案:

答案 0 :(得分:2)

我现在使用SinbadEVawrigley的想法在MS Access 2007中创建具有专业外观的HTML报告。在我的情况下,我不得不使用另一个技巧:

我发现,由于MS Access中的某些错误,它无法正确地将报告保存为txt格式。有时它会丢弃大量信息,即使它显示在屏幕上。我也看到了问题,这里提到有时会访问混合线。它似乎取决于几个因素,例如报告和数据是否跨越MS Acess报告中的页面。

但是我发现,导出到* .rtf确实可以正常工作。因此,该方法是制作MS Acess报告,当保存到文本文件中时会创建HTML代码(就像SinbadEV所描述的那样),但是您首先需要将其保存到* rtf。之后,您需要使用MS Word自动化从* .rtf转换为txt文件并给它.html扩展(实际上它不需要太多努力)。

除了MS word自动化之外,还可以使用Doxillion Document Converter等工具从命令行将rtf转换为文本格式。

您可以在会议记录,问题,风险,协议,操作,项目跟踪工具(http://sourceforge.net/projects/miraapt/)中查看具有此功能的数据库。

答案 1 :(得分:1)

Application对象中有一个ExportXML方法,它可以用XML导出数据库对象(表,报表等)。如果要为浏览器设置格式,则需要XSL样式表或XSTL文档:

http://msdn.microsoft.com/en-us/library/bb258194(v=office.12).aspx

我会说这是“规范”的做法。 OTOH写作XSL& XSTL不是一件有趣的事情,如果你的HTML生成器工作,那么你应该保持它就像它一样。 (实际上,这是一个很好的技巧恕我直言。)

答案 2 :(得分:0)

以防你想要采用VBA方式:我写了一些功能,可以很容易:

  • 创建包含您要输出的数据的查询
  • 然后打开查询并循环遍历所有记录,使用下面的函数rRsToXml将数据输出到文本文件。

    Option Compare Database
    Option Explicit
    
    Function fRsToXml(rs As Recordset, Optional ignorePrefix As String = "zz", _
                    Optional ignoreNulls As Boolean = False) As String
    '<description>  Returns an XML string with all fields of the current record,
    '               using field names as tags.
    '               Field names starting with "zz" (or other special prefix) are ignored</description>
    '<parameters>   rs: recordset (byRef, of course)</parameters>
    '<author>       Patrick Honorez - www.idevlop.com  </author>
        Dim f As Field, bPrefLen As Byte
        Dim strResult As String
        bPrefLen = Len(ignorePrefix)
        For Each f In rs.Fields
            If Left(f.Name, bPrefLen) <> ignorePrefix Then 'zz fields are ignored !
                If (Not ignoreNulls) Or (ignoreNulls And Not IsNull(f.Value)) Then
                    strResult = strResult & xTag(f.Name, f.Value) & vbCrLf
                End If
            End If
        Next f
        fRsToXml = strResult
    End Function
    
    Function xTag(ByVal sTagName As String, ByVal sValue, Optional SplitLines As Boolean = False) As String
    '<description>  Create an xml node and returns it as a string   </description>
    '<parameters>   <sTagName>  name of the tag </sTagName>
    '               <sValue>    string to embed </sValue>
    '               <SplitLine> True to include CrLf at the end of each line
    '                           (optional - default = False) </SplitLine></parameters>
    '<author>        Patrick Honorez - www.idevlop.com  </author>
    '<note>          Make sure sValue does not contains XML forbidden characters ! </note>
    '<changelog>
    '</changelog>
        Dim strNl As String, intAmp
        If SplitLines Then
            strNl = vbCrLf
        Else
            strNl = vbNullString
        End If
    
        xTag = "<" & sTagName & ">" & strNl & _
                Nz(sValue, "") & strNl & _
                "</" & sTagName & ">" '& strNl
    End Function
    
    Function CleanupStr(strXmlValue) As String
    '<description>  Replace forbidden char. &'"<> by their Predefined General Entities </description>
    '<author>       Patrick Honorez - www.idevlop.com  </author>
        Dim sValue As String
        If IsNull(strXmlValue) Then
            CleanupStr = ""
        Else
            sValue = CStr(strXmlValue)
            sValue = Replace(sValue, "&", "&amp;")  'do ampersand first !
            sValue = Replace(sValue, "'", "&apos;")
            sValue = Replace(sValue, """", "&quot;")
            sValue = Replace(sValue, "<", "&lt;")
            sValue = Replace(sValue, ">", "&gt;")
            CleanupStr = sValue
        End If
    End Function
    

答案 3 :(得分:0)

在你所做的事情中,我没有看到任何天生的“邪恶”。我为(现已解散的杂志)Smart Access撰写了一篇文章,其中出于不同的原因使用了类似的技术。 HTML报告是副产品。从本质上讲,我的技术允许使用Access创建非常广泛的word文档,这些文档像打字文本一样流动,而不是看起来像使用框创建的报告。

您仍然可以阅读MSDN上的文章: Extending Access Reports With Word and HTML

诀窍是使用您正在执行的报告生成HTML,然后使用自动化,在Word中打开.html文件并将其另存为RTF。

我们使用该技术为约克教区创建了一个300页的目录。它完美无缺。

答案 4 :(得分:0)

我曾经欺骗报告生成器为我制作HTML文档,但这种方法有局限性。首先,当您运行报表时,它会生成相当难看的html而不是打印就绪报告。运行报表后,还有更多的工作要将报表转换为一个漂亮的html文档,该文档可以在文字处理程序中打开,然后保存为常规文档。 LibreOffice通常比ms-word更好地接收生成的html文档,但偶尔LibreOffice无法完成这项工作(有一段时间它与链接图像有问题)。字处理器忽略了CSS样式,所以不要为样式烦恼,直接格式化仍然很好,特别是对于文本是表。如果所有导出的数据都在html表中,那么使用LibreOffice,因为LibreOffice可以根据h1,h2,h3标题生成目录,而ms-word则不能。

现在,我只是将整个报告编写为VBA标准模块中的过程。我仍然不使用面向对象的代码,没有理由在这里。完全用VBA编写的报告可能比标准的ms-Access报告设计者可以生成的报告复杂得多。报告设计师报告需要进行大量的修改才能使格式恰到好处,这会花费时间。对于复杂的报告,VBA方法实际上更快。用VBA编写的报告可以每隔一秒运行一次,因此很容易调整某些内容,例如表的列宽,并重新运行报告以检查输出。使用VBA创建的html报告是作为html文件写出的,ms-access可以发出shell命令以在Web浏览器中打开报告。如果浏览器已打开,则新报告将在新选项卡中打开,以便您可以查看以前版本的内容,因为此版本仍将在另一个选项卡中打开。

将报告写入标准模块(不在表单模块中),并从表单上的某个按钮单击事件中调用它。只需要告知报告标题是什么,输出文件名和位置是什么以及报告应该输出的数据范围。报告过程包含创建报告所需的所有其他逻辑。以下是在我的某个应用程序中触发报告的调用过程。调用代码的目的是在分隔的文本文件中导出带地理标记的照片列表,以便我可以在地图上绘制照片位置。导出html文件的过程非常相似。一些自定义函数在下面的代码中,但结构应该是可识别的。

Private Sub cmdCSV_File_Click()

    Dim FolderName As String
    Dim FileName As String
    Dim ReportTitle As String
    Dim SQL As String
    Dim FixedFields As String
    Dim WhereClause As String
    Dim SortOrder As String


    'Set destination of exported data
    FolderName = InputBox("Please enter name of folder to export to", AppName, mDefaultFolder)
    If mPaths.FolderExists(FolderName).Success Then
        mDefaultFolder = FolderName  'holds default folder name in case it is needed again
    Else
        MsgBox "Can't find this folder", vbCritical, AppName
        Exit Sub
    End If
    FileName = CheckTrailingSlash(FolderName) & "PhotoPoints.txt"

    'Set Report Title
    If Nz(Me.chkAllProjects, 0) Then
        ReportTitle = "Photos from all Projects"
    ElseIf Nz(Me.SampleID, 0) Then
        ReportTitle = "Photos from Sample " & Me.SampleID
    ElseIf Nz(Me.SurveyID, 0) Then
        ReportTitle = "Photos from Survey " & Me.SurveyID
    ElseIf Nz(Me.ProjectID, 0) Then
        ReportTitle = "Photos from Project " & Me.ProjectID
    Else
        MsgBox "Please select a scope before pressing this button", vbExclamation, AppName
        Exit Sub
    End If

    'Update paths to photos
    If Have(Me.ProjectID) Then
        WhereClause = " (PhotoPath_ProjectID = " & Me.ProjectID & ")"  'also covers sample and survey level selections
    Else
        WhereClause = " True"  'when all records is selected
    End If
    Call mPhotos.UpdatePhotoPaths(WhereClause) 'refreshes current paths

    'Set fixed parts of SQL statement
    FixedFields = "SELECT Photos.*, PhotoPaths.PhotoPath_Alias, PhotoPaths.CurrentPath & Photos.PhotoName AS URL, " _
    & "PhotoPaths.CurrentPath & 'Thumbs\'  & Photos.PhotoName as Thumb " _
    & "FROM Photos INNER JOIN PhotoPaths ON Photos.PhotoPathID = PhotoPaths.PhotoPathID WHERE "
    SortOrder = " ORDER BY ProjectID, SurveyID, SampleID, Photo_ID"

    'set scope for export
    WhereClause = "(((Photos.Latitude) Between -90 And 90) AND ((Photos.Longitude) Between -180 And 180) AND ((Photos.Latitude)<>0) AND ((Photos.Longitude)<>0)) AND " & WhereClause
    SQL = FixedFields & WhereClause & SortOrder & ";"

    'Export data as a delimited list
    FileName = ExportCSV(FileName, SQL)
    Call OpenBrowser(FileName)

End Sub

下一段代码实际上写出了分隔文本文件(html只有标签而不是管道)。在这种情况下,垂直条或管道用于分隔值而不是逗号,因为数据中可能出现逗号。代码可以计算出自己有多少列,并将标题放在顶部。

    Public Function ExportCSV(FileAddress As Variant, SQL As String) As String
        If Not gDeveloping Then On Error GoTo procerr

        PushStack ("mfiles.ExportCSV")

        'Exports a csv file

        If Nz(FileAddress, "") = "" Then
            ExportCSV = "Failed"
            Exit Function
        End If

        'Create text file:
        Dim webfile As Object, w
        Set webfile = CreateObject("Scripting.FileSystemObject")
        Set w = webfile.CreateTextFile(FileAddress, True)

        Dim D As Database, R As Recordset, NumberOfFields As Long, Out As String, i As Long

        Set D = CurrentDb()
        Set R = D.OpenRecordset(SQL, dbOpenSnapshot)
        If R.RecordCount > 0 Then
            With R
            NumberOfFields = .Fields.Count - 1

            'Field headings
            For i = 0 To NumberOfFields
                If i = 0 Then
                    Out = .Fields(i).Name
                Else
                    Out = Out & "|" & .Fields(i).Name
                End If
            Next
            w.writeline Out

            'Field data
            Do Until .EOF
                For i = 0 To NumberOfFields
                If i = 0 Then
                    Out = .Fields(i)
                Else
                    Out = Out & "|" & .Fields(i)
                End If
                Next i
                w.writeline Out
                .MoveNext
            Loop
            End With
        End If

    Set R = Nothing
    Set D = Nothing

    ExportCSV = FileAddress

exitproc:
        PopStack
        Exit Function

procerr:
        Call NewErrorLog(Err.Number, Err.Description, gCurrentProc, FileAddress & ", " & SQL)
        Resume exitproc

End Function

以下是openbrowser函数的一个片段。该功能的其余部分涉及确定Web浏览器的位置,因为这随Windows的版本以及浏览器是32位还是64位而变化。

'Set up preferred browser
If Right(BrowserPath, 9) = "Opera.exe" Then
    FilePrefix = "file://localhost/"
ElseIf Right(BrowserPath, 11) = "Firefox.exe" Then
    FilePrefix = "file:///"
Else
    FilePrefix = ""
End If

'Show report
Instruction = BrowserPath & " " & FilePrefix & WebpageName
TaskSuccessID = Shell(Instruction, vbMaximizedFocus)

此示例包含创建html报告所需的大约90%的代码,该报告的范围由调用它的表单设置。希望这会让某人超越驼峰。