VBA — отправить электронное письмо с вложением

#vba

Вопрос:

С прошлой недели по настоящее время у меня есть несколько вопросов, связанных с тем, отправлял ли мини-проект электронное письмо с вложением с помощью Excel VBA. Теперь я нахожусь на последнем этапе. Мой проект-отправить электронное письмо с соответствующим вложением (хранится в определенной папке). что-то вроде этого:

введите описание изображения здесь
введите описание изображения здесь

Вот мой код:

 Sub SendEmail_Example1()
' email processing

For i = 2 To Sheet2.Range("A" amp; Rows.Count).End(xlUp).Row
Dim EmailApp As Outlook.Application
Dim Source As String
Set EmailApp = New Outlook.Application

Dim EmailItem As Outlook.MailItem
Set EmailItem = EmailApp.CreateItem(olMailItem)

EmailItem.To = Sheet2.Range("D" amp; i).Value
'EmailItem.CC = "hello@gmail.com"
'EmailItem.BCC = "hhhh@gmail.com"
EmailItem.Subject = "User info of " amp; Sheet2.Range("D" amp; i).Value
EmailItem.HTMLBody = "Hi, below is your user info " amp; "<br>" amp; "User is: " amp; Sheet2.Range("B" amp; i).Value amp; "<br>" amp; _
"Password is : " amp; vbNewLine amp; Sheet2.Range("C" amp; i).Value amp; _
vbNewLine amp; vbNewLine amp; _
"<br>" amp; "Regards," amp; _
"<br>" amp; "VT"
'Source = ThisWorkbook.FullName
'---------Attachment
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim file As file
Dim folder As folder
Set folder = fso.GetFolder("C:test")
'Source = "C:test"
For Each file In folder.Files
    If Sheet1.Range("A" amp; i).Value = file.Name Then
        
        EmailItem.Attachments.Add file.Name
        Exit For
        
    End If
Next file
    
EmailItem.Send
Next i
End Sub
 

Я хотел бы захватить соответствующее вложение с каждым исходящим письмом, что означает, что электронное письмо, отправленное пользователю с именем «джек», получит вложение с именем «jack.xlsx»

введите описание изображения здесь

Не могли бы вы, пожалуйста, помочь в этом вопросе ? Я очень благодарен за всю поддержку

Ответ №1:

Есть 2 проблемы с частью FSO/вложения вашего кода:

  1. file.Name вернет файл с расширением, которое не будет соответствовать значению в вашем столбце A, поэтому вам нужно использовать fso.GetBaseName , чтобы получить имя файла без расширения.
  2. Вам необходимо указать полный путь к файлу, чтобы добавить вложение, поэтому используйте file.Path вместо file.Name .
     Dim fso As FileSystemObject
    Set fso = New FileSystemObject
    Dim file As file
    Dim folder As folder
    Set folder = fso.GetFolder("C:test")
    'Source = "C:test"
    For Each file In folder.Files
        If Sheet1.Range("A" amp; i).Value = fso.GetBaseName(file.Name) Then
    
            EmailItem.Attachments.Add file.Path
            Exit For
    
        End If
    Next file
    
    EmailItem.Send