Удаление пустых значений ячеек из строки кода для вставки в тело письма

Question

В моем коде Листа 1 приведен следующий фрагмент кода, в котором значения ячеек перемещаются в тело электронного письма Outlook. Я пытаюсь выяснить, как сделать СТОП вставки текста для данной строки, если ячейка в столбце А пуста. Кто-нибудь может помочь мне понять, как это сделать? Я заранее ценю любую помощь, которую вы можете оказать!

Private Sub CommandButton1_Click()
'Create email with attachment, subject, and list of email addresses
ThisWorkbook.Save
Dim outlookApp As Object
Dim myMail As Object
Dim Source_File, to_emails, cc_emails As String
Dim file_to_send As String
Dim body_code As String
Dim i As Integer

Set outlookApp = CreateObject("Outlook.Application")
Set myMail = outlookApp.CreateItem(olMailItem)

For i = 2 To 22
    to_emails = to_emails & Cells(i, 13) & ";"
    'for CC: change the 13 to whatever column count from the left where your CC list is
    'cc_emails = cc_emails & Cells(i, 13) & ";"
Next i

Source_File = ThisWorkbook.FullName
myMail.Attachments.Add Source_File

'myMail.CC = cc_emails
myMail.To = to_emails
myMail.Subject = Range("Q2").Value & " 10-8 Form " & Format(Date, "mm/dd/yy")

myMail.Body = Range("B2") & " Shift" & "  -  " & Format(Date, "mmmm dd, yyyy") _
    & vbNewLine & vbNewLine & "Sergeant: " & Range("A6") & ", " & Range("B6") & vbNewLine & "          Status: " & Range("C6") _
    & vbNewLine & vbNewLine & "Corporal: " & Range("A8") & ", " & Range("B8") & vbNewLine & "          Status: " & Range("C8") _
    & vbNewLine & vbNewLine & "Assigned Deputies" & vbNewLine & vbNewLine & _
    Range("A10") & ", " & Range("B10") & vbNewLine & "          Assignment/Zone: " & Range("C10") & vbNewLine & _
    Range("A11") & ", " & Range("B11") & vbNewLine & "          Assignment/Zone: " & Range("C11") & vbNewLine & _
    Range("A12") & ", " & Range("B12") & vbNewLine & "          Assignment/Zone: " & Range("C12") & vbNewLine & _
    Range("A13") & ", " & Range("B13") & vbNewLine & "          Assignment/Zone: " & Range("C13") & vbNewLine & _
    Range("A14") & ", " & Range("B14") & vbNewLine & "          Assignment/Zone: " & Range("C14") & vbNewLine & _
    Range("A15") & ", " & Range("B15") & vbNewLine & "          Assignment/Zone: " & Range("C15") & vbNewLine & _
    Range("A16") & ", " & Range("B16") & vbNewLine & "          Assignment/Zone: " & Range("C16") & vbNewLine & _
    Range("A17") & ", " & Range("B17") & vbNewLine & "          Assignment/Zone: " & Range("C17") & vbNewLine & _
    Range("A18") & ", " & Range("B18") & vbNewLine & "          Assignment/Zone: " & Range("C18")

myMail.Display
ThisWorkbook.Save

End Sub

Answer 1

Вот окончательный код, тот, который, наконец, сделал это. Спасибо jclasley

`Private Sub CommandButton1_Click()
'Create email with attachment, subject, and list of email addresses
ThisWorkbook.Save
Dim outlookApp As Object
Dim myMail As Object
Dim Source_File, to_emails, cc_emails As String
Dim file_to_send As String
Dim i As Integer
Dim concatString As String

Set outlookApp = CreateObject("Outlook.Application")
Set myMail = outlookApp.CreateItem(olMailItem)

For i = 2 To 22
    to_emails = to_emails & Cells(i, "M") & ";"
    'for CC: change the 13 to whatever column count from the left where your CC list is
    'cc_emails = cc_emails & Cells(i, 13) & ";"
Next i

Source_File = ThisWorkbook.FullName
myMail.Attachments.Add Source_File

'myMail.CC = cc_emails
myMail.To = to_emails
myMail.Subject = Range("Q2").Value & " 10-8 Form " & Format(Date, "mm/dd/yy")

For i = 10 To 18
    If Not Cells(i, "A").Text = vbNullString Then
         'Add to growing string
         concatString = concatString + Cells(i, "A").Text & ", " & Cells(i, "B").Text & vbCr
         concatString = concatString + "Assignment/Zone: " & Cells(i, "C").Text & vbNewLine & vbCr
    End If
Next i

myMail.Body = Range("B2") & " Shift" & "  -  " & Format(Date, "mmmm dd, yyyy") _
    & vbNewLine & vbNewLine & "Sergeant: " & Range("A6") & ", " & Range("B6") & vbNewLine & "          Status: " & Range("C6") _
    & vbNewLine & vbNewLine & "Corporal: " & Range("A8") & ", " & Range("B8") & vbNewLine & "          Status: " & Range("C8") _
    & vbNewLine & vbNewLine & "Assigned Deputies" & vbNewLine & vbNewLine & concatString

myMail.Display
ThisWorkbook.Save

End Sub

enter code here

Answer 2

Я бы обязательно разбил ту огромную стену текста, которая у тебя есть. Это можно сделать с помощью al oop.

. Давайте использовать For l oop.

Dim concatString as String

For i = 10 To 18
    If Not Cells(i, "A").Text = vbNullString Then
         'Add to growing string
         concatString = concatString + Cells(i, "A").Text & ", " & Cells(i, "B").Text & vbCr
         concatString = concatString + "Assignment/Zone: " & Cells(i, "C").Text & vbCr
    End If
Next i

Если столбец A содержит пустую строку, мы пропускаем ее и перейти к следующему ряду.

Я опубликовал это, прежде чем вы добавили больше кода, но я думаю, вы поняли идею. Разбейте огромный кусок кода и поместите только один цикл через столбцы A, B и C в l oop. При необходимости измените ограничения l oop.

Вот как это будет выглядеть в вашем коде:

'...
'your code here
'...

Dim concatString as String

For i = 10 To 18
    If Not Cells(i, "A").Text = vbNullString Then
         'Add to growing string
         concatString = concatString + Cells(i, "A").Text & ", " & Cells(i, "B").Text & vbCr
         concatString = concatString + "Assignment/Zone: " & Cells(i, "C").Text & vbCr
    End If
Next i

myMail.Body = Range("B2") & " Shift" & "  -  " & Format(Date, "mmmm dd, yyyy") _
    & vbNewLine & vbNewLine & "Sergeant: " & Range("A6") & ", " & Range("B6") & vbNewLine & "          Status: " & Range("C6") _
    & vbNewLine & vbNewLine & "Corporal: " & Range("A8") & ", " & Range("B8") & vbNewLine & "          Status: " & Range("C8") _
    & vbNewLine & vbNewLine & "Assigned Deputies" & vbNewLine & vbNewLine & concatString

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