У меня есть файл Excel, из которого я собираю уникальные идентификаторы электронной почты и отправляю электронную почту с деталями идентификатора пользователя в теле. Теперь возникает такая ситуация, что если существует более 5 записей, данные следует отправлять в виде вложения Excel. Я застрял в этом, как выполнить эту операцию.
У меня EXCEL ШАБЛОН КАК:
И Macro Class как AppInfo :
Option Explicit
Public mID As String
Public mNewState As String
Public mDDate As String
Public mAgenCode As String
Public mUserID As String
Public mUserManager As String
Public mUserName As String
Public mEntitelment As String
Public mAppName As String
Public mAppID As String
и Module as:
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, 5)
Set myAppInfo = New AppInfo
With myAppInfo
.mID = sngRow.Cells(1, 1)
.mNewState = sngRow.Cells(1, 2)
.mDDate = sngRow.Cells(1, 3)
.mAgenCode = sngRow.Cells(1, 4)
.mUserManager = sngRow.Cells(1, 6)
.mUserName = sngRow.Cells(1, 7)
.mEntitelment = sngRow.Cells(1, 8)
.mAppName = sngRow.Cells(1, 9)
.mAppID = sngRow.Cells(1, 10)
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 account permissions below:" & vbCrLf
For Each emailAdress In emailInformation
Set colLines = emailInformation(emailAdress)
sBodyInfo = ""
For Each line In colLines
sBodyInfo = sBodyInfo & _
"Application: " & line.mUserName & vbTab & "Version:" & line.mUserManager & vbCrLf
Next
sBodyEnd = "Best Regards" & vbCrLf & _
"Team"
sBody = sBodyStart & sBodyInfo & sBodyEnd
SendEmail emailAdress, "Permissions", 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
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
Я могу отправить содержимое по электронной почте, но хотел бы знать, как передавать данные сбора в виде приложения Excel. Спасибо.