>
아래 코드는 Excel 파일에서 데이터를 추출하여 이메일 주소로 모든 데이터를 통합하고 해당 이메일 주소로 데이터를 보냅니다. 잘 작동하지만 데이터를 더 좋아 보이게하려고합니다. 아래 정보에서 표를 만드는 방법이 있습니까?

이메일에 아래와 같은 헤더가 포함되도록하고 싶습니다 :

|_____|_____|_____|_____|
|_____|_____|_____|_____|

OFT 파일에 대한 임시 테이블을 보았지만 다음 코드를 사용하여 Excel에서 직접 볼 수는 없지만이 코드에서 동일한 작업을 수행하는 방법을 모르겠습니다.

tmpTbl = tmpTbl & "<tr><td></td><td></td><td align=""center"">*Company</td></tr></table>"

<시간>

Option Explicit
Sub Consolidate()
    #If Early Then
        Dim emailInformation As New Scripting.Dictionary
    #Else
        Dim emailInformation As Object
        Set emailInformation = CreateObject("Scripting.Dictionary")
    #End If
    GetEmailInformation emailInformation
    SendInfoEmail emailInformation
End Sub
Sub GetEmailInformation(emailInformation As Object)
    Dim rg As Range
    Dim sngRow As Range
    Dim emailAddress As String
    Dim myAppInfo As AppInfo
    Dim AppInfos As Collection
    Set rg = Range("A1").CurrentRegion           ' Assuming the list starts in A1 and DOES NOT contain empty row
    Set rg = rg.Offset(1).Resize(rg.Rows.Count - 1) ' Cut the headings
    For Each sngRow In rg.Rows
        emailAddress = sngRow.Cells(1, 1)
        Set myAppInfo = New AppInfo
        With myAppInfo
            .app = sngRow.Cells(1, 2)            'code
            .version = sngRow.Cells(1, 3)        'Company Name
            .ticker = sngRow.Cells(1, 4)         'Abbreviation
            .group = sngRow.Cells(1, 5)          'group sub group
            .lead = sngRow.Cells(1, 6)           'leader
            .banker = sngRow.Cells(1, 7)         'bank
            .analyst = sngRow.Cells(1, 8)        'analyst
            .otw = sngRow.Cells(1, 9)            'at
            .rating = sngRow.Cells(1, 10)        'rank
            .watchlist = sngRow.Cells(1, 11)     'Comments
            .legal = sngRow.Cells(1, 12)         'notes
            .add = sngRow.Cells(1, 13)           'Date
            .last = sngRow.Cells(1, 14)          'Updated
            .id = sngRow.Cells(1, 15)            'ID
        End With
        If emailInformation.Exists(emailAddress) Then
            emailInformation.item(emailAddress).add myAppInfo
        Else
            Set AppInfos = New Collection
            AppInfos.add myAppInfo
            emailInformation.add emailAddress, AppInfos
        End If
    Next
End Sub
Sub SendInfoEmail(emailInformation As Object)
    Dim sBody As String
    Dim sBodyStart As String
    Dim sBodyInfo As String
    Dim sBodyEnd As String
    Dim emailAdress As Variant
    Dim colLines As Collection
    Dim line As Variant
    sBodyStart = "Hi, please find your info below:" & vbCrLf & vbCrLf
    For Each emailAdress In emailInformation
        Set colLines = emailInformation(emailAdress)
        sBodyInfo = ""
        For Each line In colLines
            sBodyInfo = sBodyInfo & _
                        "Code: " & line.app & vbTab & "Company Name:   " & line.app & vbTab & "abbreviation:   " & line.abbreviation & vbTab & "Group Sub Group:   " & line.group & vbTab & "Bank:   " & line.lead & vbTab & "Analyst:   " & line.analyst & vbTab & "at:   " & line.at & vbTab & "Rank:   " & line.rank & vbTab & "Comments:   " & line.comments & vbTab & "Notes:   " & line.notes & vbTab & "Date:   " & line.add & vbTab & "Updated:   " & line.updated & vbTab & "ID:   " & line.id & vbCrLf
        Next
        sBodyEnd = "Best Regards," & vbCrLf & _
                   "Tom"
        sBody = sBodyStart & sBodyInfo & sBodyEnd
        SendEmail emailAdress, "Info", sBody
    Next
End Sub
Sub SendEmail(ByVal sTo As String _
              , ByVal sSubject As String _
               , ByVal sBody As String _
                , Optional ByRef coll As Collection)
    #If Early Then
        Dim ol As Outlook.Application
        Dim outMail As Outlook.MailItem
        Set ol = New Outlook.Application
    #Else
        Dim ol As Object
        Dim outMail As Object
        Set ol = CreateObject("Outlook.Application")
    #End If
    Set outMail = ol.CreateItem(0)
    With outMail
        .To = sTo
        .Subject = sSubject
        .Body = sBody
        .VotingOptions = "Accept;Reject"
        .Importance = 2
        If Not (coll Is Nothing) Then
            Dim item As Variant
            For Each item In coll
                .Attachments.add item
            Next
        End If
        .Display
        .Send
    End With
    Set outMail = Nothing
End Sub

  • 답변 # 1

    일반 텍스트 Body 를 설정하는 대신  속성, 테이블과 함께 유효한 HTML 문자열을 구성하고 HTMLBody 에 할당  

  • 답변 # 2

    이 코드를 테스트 할 확실한 방법이 없으므로 구문 오류가있을 수 있습니다. 필요한 경우 코드를 수정할 수 있도록 충분한 설명이 포함되어 있다고 생각합니다. 그렇지 않은 경우 오류가있는 설명을 게시하면 원인을 진단 할 것입니다.

    가장 간단한 HTML을 사용했습니다. 더 많은 형식이 필요한 경우 몇 가지 제안을 해줄 수 있습니다.

    Html 테이블은 다음과 같습니다. <table> ... <table>

    Html 행은 다음과 같습니다. <tr> ... </tr>

    HTML 세포는 : <td> ... </td>

    Html 단락은 다음과 같습니다. <p> ... </p>

    이니 티즈 sBodyStart  그리고 sBodyEnd :

    sBodyStart = "<p>Hi, please find your info below:</p>"
    sBodyEnd = "<p>Best Regards,<br>Tom</p>"
    
    

    신고에 추가 :

    Dim CellValue As Variant
    
    

    와이즈 비즈 교체   sbodyInfo = "" 로  포함 :

    Next
    
    

    sBodyInfo = "<table>" sBodyInfo = sBodyInfo & "<tr>" For Each CellValue in Array("Code", "Company Name", "Abbreviation", _ "Group Sub Group", "Bank", "Analyst", _ "At","Rank","Comments","Notes","Date", _ "Updated","ID") sBodyInfo = sBodyInfo & "<td>" & CellValue & "</td>" Next sBodyInfo = sBodyInfo & "</tr>" For Each line In colLines sBodyInfo = sBodyInfo & "<tr>" For Each CellValue in Array(line.app, line.app, line.abbreviation, _ line.group, line.lead, line.analyst, _ line.at, line.rank, line.comments, _ line.notes, line.add, line.updated, line.id) sBodyInfo = sBodyInfo & "<td>" & CellValue & "</td>" Next sBodyInfo = sBodyInfo & "</tr>" Next sBodyInfo = sBodyInfo & "</table>"

관련 자료

  • 이전 android - 주문 된 방송을 보낼 때 FLAG_RECEIVER_FOREGROUND의 기능은 무엇입니까?
  • 다음 user interface - Jenkins UI Textfinder 여러 정규식을 설정하는 방법