Question

我在社区中的第一条帖子...

我用VBA编写了一个代码，该代码将根据给定的记录集创建数组，然后我想在电子邮件中使用这些数组（由代码创建）。我希望这些数组位于已定义的标题下的一列中。下面是我编写的代码：

Private Sub Command18_Click()

Dim myOutlook As Outlook.Application
Dim myMail As Outlook.MailItem

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim i As Integer


Set db = CurrentDb()
Set rs = db.OpenRecordset("Q-EmailList", dbOpenDynaset, , 2)

Set myOutlook = New Outlook.Application
Set myMail = myOutlook.CreateItem(olMailItem)

rs.MoveLast
rs.MoveFirst

Do Until rs.EOF
    If rs![ID] = Me.ID.Value Then
        i = rs.RecordCount
        i = i - 1
        Exit Do
    Else
        rs.MoveNext
    End If
Loop

rs.MoveFirst

Dim DBUser As String
DBUser = Environ("UserName")

Dim DoS() As String
Dim DoSa As String
Dim CPT() As String
Dim CPTa As String
Dim Diag() As String
Dim Diaga As String
Dim Typ() As String
Dim Typa As String
Dim Rea() As String
Dim Reaa As String
Dim Acta As String
Dim Namea As String

For cnt = 0 To i
    ReDim Preserve DoS(cnt)
    DoS(cnt) = Format(rs![DoS], "m/d/yyyy")
    rs.MoveNext
Next cnt
DoSa = Join(DoS(), vbNewLine)
rs.MoveFirst
For cnt = 0 To i
    ReDim Preserve CPT(cnt)
    CPT(cnt) = rs![CPT]
    rs.MoveNext
Next cnt
CPTa = Join(CPT(), vbNewLine)
rs.MoveFirst
For cnt = 0 To i
    ReDim Preserve Diag(cnt)
    Diag(cnt) = rs![Diag]
    rs.MoveNext
Next cnt
Diaga = Join(Diag(), vbNewLine)
rs.MoveFirst
For cnt = 0 To i
    ReDim Preserve Typ(cnt)
    Typ(cnt) = rs![Type]
    rs.MoveNext
Next cnt
Typa = Join(Typ(), vbNewLine)
rs.MoveFirst
For cnt = 0 To i
    ReDim Preserve Rea(cnt)
    Rea(cnt) = rs![Canned]
    rs.MoveNext
Next cnt
Reaa = Join(Rea(), vbNewLine)
rs.MoveFirst

Acta = rs![Act]
Namea = rs![PatName]

rs.MoveNext

        myMail.To = "aauton@summithealthcare.com"
        myMail.CC = "aauton@summithealthcare.com"
        myMail.BCC = ""
        myMail.Subject = "A request for a coding change for " & rs![PatName] & " Act #: " & rs![Act] & " has been requested."
        myMail.BodyFormat = olFormatHTML
        myMail.HTMLBody = "<font face=Arial>A request for a coding change has been requested. Please review the details below for the request.</font><p>" _
        & "<font face=Arial><font color=""red"">Act #: </font><font face=Arial><font color=""black"">" & rs![Act] & " </font><p>" _
        & "<font face=Arial><font color=""red"">Patient Name: </font><font face=Arial><font color=""black"">" & rs![PatName] & " </font><p>" _
        & "<font face=Arial><font color=""red"">Date of Service: &nbsp;&nbsp;&nbsp;&nbsp;&nbsp; CPT: &nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Diagnosis: &nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Type of Change: &nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Reason: </font><p>" _
        & "<font face=Arial><font color=""black"">" & DoSa & " &nbsp;&nbsp;&nbsp;&nbsp;&nbsp; " & CPTa & " &nbsp;&nbsp;&nbsp;&nbsp;&nbsp; " & Diaga & " &nbsp;&nbsp;&nbsp;&nbsp;&nbsp; " & Typa & " &nbsp;&nbsp;&nbsp;&nbsp;&nbsp; " & Reaa & "</font><p>" _
        & "<font face=Arial><font color=""red"">Once the request has been reviewed, please provide the appropriate codes that will be needed for the change to be implemented. Thank you.</font><p>"
        myMail.Display
        rs.Edit
        rs![Emailed] = True
        rs![EmailDate] = Now()
        rs.Update

Set myMail = Nothing
Set myOutlook = Nothing

MsgBox "Closing the Database", vbOKOnly, "End"
DoCmd.Close acForm, "Frm-RequestEntry", acSaveNo
'DoCmd.Quit

End Sub

使用VBA在电子邮件内部以列格式显示数组

0 个答案: