我想从特定文件夹(路径)添加附件我正在寻找宏来从 D 列中获取附件名称,但只有最后一个单词作为文件夹中的附件将只包含给定文件夹中的最后一个单词。
例如。在 D2 宏中将在指定文件夹中搜索单词“QR”并添加附件。
Sub SendMultipleEmailsaa()
Dim Mail_Object, OutApp As Object
Dim ws As Worksheet: Set ws = ActiveSheet
Dim arr() As Variant
LastRow = ws.Cells(ws.Rows.Count, "b").End(xlUp).Row
ws.Sort.SortFields.Clear
ws.Sort.SortFields.Add Key:=ws.Range("A2:A" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ws.Sort
.SetRange ws.UsedRange
.Header = False
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
arr = ws.Range("A2:A" & LastRow)
Set Mail_Object = CreateObject("Outlook.Application")
first = 2
For i = LBound(arr) To UBound(arr)
If i = UBound(arr) Then GoTo YO
If arr(i + 1, 1) = arr(i, 1) Then
first = WorksheetFunction.Min(first, i + 1)
Else
YO:
Set OutApp = Mail_Object.CreateItem(0)
With OutApp
.Subject = ws.Range("C" & i + 1).Value
.Body = "Your message here"
.Display
.To = ws.Range("B" & i + 1).Value
For j = first To i
.Recipients.Add ws.Range("B" & j).Value
Next
first = i + 2
End With
End If
Next
End Sub
更改这部分代码:
With OutApp
.Subject = ws.Range("C" & i + 1).Value
.Body = "Your message here"
.Display
.To = ws.Range("B" & i + 1).Value
For j = first To i
.Recipients.Add ws.Range("B" & j).Value
Next
first = i + 2
End With
和:
pth = "F:\WIN7PROFILE\Desktop\File\"
With OutApp
.Subject = ws.Range("C" & i + 1).Value
.Body = "Your message here"
.Display
.To = ws.Range("A" & i + 1).Value
.Attachments.Add pth & Dir(pth & "*" & Replace(ws.Range("D" & i + 1).Value, "File - Fund ", "") & "*")
For j = first To i
.Recipients.Add ws.Range("A" & j).Value
Next
first = i + 2
End With
本文收集自互联网,转载请注明来源。
如有侵权,请联系[email protected] 删除。
我来说两句