创建Outlook电子邮件并在每个电子邮件的最大文件数量的文件夹中附加文件

Question

我需要创建Outlook电子邮件并附加最多10个文件。
如果有16个文件，那么应该创建2个电子邮件，第一个包含10个文件，第二个包含剩下的6个文件。

当我尝试附加文件时，它给出

对象不支持此属性或方法。

Sub attach()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
'Dim temp_Attach As Object

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
.Title = "Select a Folder"
sFolder = .SelectedItems(1)
End With

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(sFolder)
Set fls = f.Files

Z = 10

For d = 0 To fls.Count - 1 Step 10

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'On Error Resume Next
With OutMail
.To = "[e-mail]"
.CC = ""
.subject = "file"

y = 0
For Each x In fls
If y < Z Then
.Attachements.Add (sFolder & "" & x.Name)
y = y + 1
Else
Exit For
End If

Z = Z + 10

Next
.Display

End With

Next

End Sub

Answer 1

你把单词Attachments拼错了(你把它写成Attache)差事)。

Answer 2

下面的代码对我来说很有魅力:

Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = "[e-mail]"
.CC = ""
.subject = "file"

y = 0

For Each x In fls
If y < Z Then
.Attachments.Add (sFolder & "" & x.Name)
y = y + 1
Else
Exit For
End If

Z = Z + 10

Next
.Display

End With
Next

Answer 3

添加两个附件的运行计数，

• 显示达到每封邮件限制并重新启动邮件限制计数。
• 当文件夹总数达到时显示。

Option Explicit
Sub attach()
Dim OutApp As Object
Dim OutMail As Object

Dim sFolder As Variant
Dim sFile As Variant

Dim fs As Object
Dim f As Object
Dim fls As Object
Dim flsCount As Long

Dim attLimit As Long
Dim attCountEmail As Long
Dim attCountTotal As Long

With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then ' if OK is pressed
.Title = "Select a Folder"
sFolder = .SelectedItems(1)
Else
Exit Sub
End If
End With

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(sFolder)
Set fls = f.Files

flsCount = fls.Count
Debug.Print " flsCount: " & flsCount

attLimit = 10

Set OutApp = CreateObject("Outlook.Application")

attCountEmail = 0
attCountTotal = 0

For Each sFile In fls

If attCountEmail = 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "[e-mail]"
.CC = ""
.Subject = "file"
End With
End If

If attCountEmail < attLimit Then
OutMail.Attachments.Add (sFolder & "" & sFile.Name)

attCountEmail = attCountEmail + 1
Debug.Print " attCountEmail: " & attCountEmail

attCountTotal = attCountTotal + 1
Debug.Print " attCountTotal: " & attCountTotal

End If

If attCountTotal = flsCount Then
OutMail.display

ElseIf attCountEmail = attLimit Then
OutMail.display
attCountEmail = 0
End If
Next

End Sub