Translate

2013年6月15日 星期六

[VBA] Convert Access Table into HTML Format

https://github.com/walter426/VbaUtilities/blob/master/AccessObjUtilities.bas
The intention to convert an Access Table into HTML format is due to the less supoort between access and outlook. In my recognition, it is impossible to copy an access table, and paste it into the body of an outlook mail directly through VBA.

Therefore, it is necessary to convert the access table into HTML format first, and insert the HTML code of the table into the HTMLBody of the outlook mail.

Below is the code.

'Convert Access Table into HTML Format
Public Function ConvertTblToHtml(Tbl_name As String, Html As String) As String
    On Error GoTo Err_ConvertTblToHtml
 
    Dim FailedReason As String
 
    If TableValid(Tbl_name) = False Then
        FailedReason = Tbl_name & "is not valid"
        GoTo Exit_ConvertTblToHtml
    End If
 

    Html = Html & "<table border = ""1"", style = ""font-size:9pt;"">" & vbCrLf

 
    Dim RS_Tbl As DAO.Recordset
    Set RS_Tbl = CurrentDb.OpenRecordset(Tbl_name)
 
    'Create table
    With RS_Tbl
        Dim fld_idx As Integer
 
        'Create header
        Html = Html & "<tr>" & vbCrLf
     
        For fld_idx = 0 To .Fields.count - 1
            Html = Html & "<th bgcolor = #c0c0c0>" & .Fields(fld_idx).Name & "</th>" & vbCrLf
        Next fld_idx 'For fld_idx = 0 To .Fields.count - 1
     
        Html = Html & "</tr>"
     
     
        'Create rows
        .MoveFirst
     
        Do Until .EOF
            Html = Html & "<tr>" & vbCrLf
         
            For fld_idx = 0 To .Fields.count - 1
                Html = Html & "<td>" & .Fields(fld_idx).Value & "</td>" & vbCrLf
            Next fld_idx 'For fld_idx = 0 To .Fields.count - 1
         
            Html = Html & "</tr>" & vbCrLf
         
            .MoveNext
        Loop

        .Close
     
    End With 'RS_TblD
 
 
    Html = Html & "</table>"
 
 
Exit_ConvertTblToHtml:
    ConvertTblToHtml = FailedReason
    Exit Function

Err_ConvertTblToHtml:
    MsgBox Err.Description
    Resume Exit_ConvertTblToHtml
End Function

沒有留言:

張貼留言