Как добавить несколько вложений из столбца из Excel, который имеет любое значение (путь к файлу) в нем - PullRequest
Новая
       16

Как добавить несколько вложений из столбца из Excel, который имеет любое значение (путь к файлу) в нем

1 голос
/ 10 июня 2019

Я пытаюсь создать код VBA, который сможет сказать Excel, чтобы добавить несколько вложений из определенного столбца, в котором есть любое значение (путь к файлу).

EG Мой столбец Excel BD2: BD2000содержит список только вложений электронной почты, и я хочу, чтобы Excel выбрал все значения из ячеек BD2: BD20000 (если они не пустые и которые в основном являются путями к файлам) и прикрепил его в виде нескольких вложений к моей электронной почте Outlook.

Однако я не могу заставить это работать.

Это то, что я имею до сих пор: 

Private Sub ToggleButton3_Click()

 Dim OutApp As Object
    Dim OutMail As Object

    Set emailRng = Worksheets("Workings").Range("BC2:BC2000")
    Set FilepathRng = Worksheets("Workings").Range("BD2:BD2000")


    For Each cl In emailRng
        sTo = sTo & ";" & cl.Value

    Next

    sTo = Mid(sTo, 2)

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    Next

    sTo = Mid(sTo, 2)


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = ComboBox17.Value
        .CC = sTo
        .BCC = ""
        .Subject = TextBox18.Value
        .Body = "Hi there"
        .Attachments.add = FilepathRng


    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing


End Sub

Благодарю, если кто-нибудь будет так любезен помочь.Я новичок в VBA, и я пытаюсь найти простые решения для этого, поэтому я буду признателен за любые подробные и простые для понимания / советы / решения, которые может дать любой.

Спасибо!

Ответы [ 2 ]

2 голосов
/ 10 июня 2019

Этот код будет прикреплять все пути к файлам в диапазоне "BC2: BC2000".

Предупреждение:

Не рекомендуется добавлять такое количество файлов в одно электронное письмо.Ваша система может зависнуть.Чтобы добавить 2000 файлов, измените диапазон в For Loop соответственно. 

Private Sub ToggleButton3_Click()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim cl As Range
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    Set emailRng = Worksheets("Workings").Range("BC2:BC2000")

    For Each cl In emailRng
        sTo = sTo & ";" & cl.Value

    Next

    sTo = Mid(sTo, 2)

    With OutMail
        .To = ComboBox17.Value
        .CC = sTo
        .BCC = ""
        .Subject = TextBox18.Value
        .Body = "Hi there"

        For Each cl In Worksheets("Workings").Range("BD2:BD2000")
            If Len(cl.Value) > 1 Then
            .Attachments.Add cl.Value
            End If
        Next

        .Display

    End With


    Set OutMail = Nothing
    Set OutApp = Nothing


End Sub
0 голосов
/ 10 июня 2019

Сначала вам нужно заполнить массив путями, например, вот так: 

With ThisWorkbook.Sheets("Workings")
    LastRow = .Cells(.Rows.Count, "BD").End(xlUp).Row
    ReDim myFileList(1 To LastRow - 2)
    i = 1
    For Each C In .Range("BD2:BD" & LastRow)
        myFileList(i) = C
        i = i + 1
    Next C
End With

Затем, чтобы добавить вложения, вам нужно сделать так: 

    For i = LBound(myFileList) To UBound(myFileList)
        .Attachments.Add myFileList(i)
    Next i
...