[英]VBA using wildcard to attach word docx
我试图想出一个代码来根据电子邮件要求附加文件。 文件名结构是一致的 - Date(YY-MM-DD) 后跟一个以 E 开头的唯一数字和不同的描述。 示例:“17-08-10 E***** 文件说明.docx”。 附加的文件将具有电子邮件正文中提到的唯一标识符。
我已经将我在搜索中找到的代码拼凑在一起,但我仍然无法弄清楚它没有附加我的文档。
这是我的代码:
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Dim EmailBody As String
Dim Mail_worksheet As Worksheet
Dim Mail_worksheet1 As Worksheet
Set Mail_worksheet = ThisWorkbook.Sheets("Email")
Set Mail_worksheet1 = ThisWorkbook.Sheets("Send")
Dim strPath As String
Dim strFilter As String
Dim strFile As String
Dim strName As String
Dim c As Integer
Dim d As String
d = ThisWorkbook.Worksheets("Sheet1").Cells(1, 4)
EmailBody = "<body style=""font-family:Calibri;font-size:16"">Hi," & "<br><br>" & _
"Document attached for:" & "<br><br>"
On Error Resume Next
For c = 0 To d - 1
If Mail_worksheet.Cells(15, 2 + c) = Mail_worksheet1.Cells(7, 6) And Mail_worksheet.Cells(4, 2 + c) Like "E*" Then
EmailBody = EmailBody & Mail_worksheet.Cells(4, 2 + c) & "<br>"
strPath = "D:\My Documents\" 'Edit to your full path
strName = Mail_worksheet.Cells(4, 2 + c)
strFilter = "*.docx"
strFile = Dir(strPath & Format(Date, "YY-MM-DD") & strName & strFilter)
While (strFile <> "")
If InStr(strFile, "") > 0 Then 'i think my problem is in this line, i'm not sure what to make of it.
newItem.Attachments.Add (strPath & strFile)
End If
strFile = Dir
Wend
End If
Next c
EmailBody = EmailBody & "<br>Thank you." & "<br><br>" & _
"Best regards,"
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.Subject = "Word doc for product - " & Format(Date, "DD MMM YYYY")
.HTMLBody = EmailBody
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
无论如何,设法弄清楚了这一点。 必须为这部分工作创建新的整数。
For a = 0 To b - 1
If Mail_worksheet.Cells(15, 2 + a) = Mail_worksheet1.Cells(7, 6) And Mail_worksheet.Cells(4, 2 + a) Like "E*" Then
strPath = "D:\My Documents\"
strName = "*" & Mail_worksheet.Cells(4, 2 + a).Value & "*.docx"
strFile = Dir(strPath & strName)
Do While Len(strFile) > 0
OutMail.Attachments.Add strPath & strFile
strFile = Dir
Loop
End If
Next a
感谢尼通的指导!
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.