VBA使用通配符附加word docx

Question

我試圖想出一個代碼來根據電子郵件要求附加文件。 文件名結構是一致的 - 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

Answer 1

無論如何，設法弄清楚了這一點。 必須為這部分工作創建新的整數。

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

感謝尼通的指導！

VBA使用通配符附加word docx

問題描述

1 個解決方案

解決方案1
0 2017-08-16 10:10:32

VBA使用通配符附加word docx

問題描述

1 個解決方案

解決方案1 0 2017-08-16 10:10:32

解決方案1
0 2017-08-16 10:10:32