从Excel通过Thunderbird发送邮件时重复发送1封邮件

我已经创建了VBA代码，用于通过Thunderbird将带有不同附件的邮件发送到不同的地址。代码看起来是正确的，但在创建特定邮件正文时，它仍然使用第一个值。奇怪的是，在调试窗口中，所有内容看起来都是正确的，并且值正在更改

$

Option Explicit  
Sub SendMailThunder_Click()  
Dim strEmpfaenger1 As String  
Dim strBetr As String  
Dim strBody As String  
Dim strFile2 As Variant  
Dim strTh As String  
Dim strCommand As Variant  
Dim Nazev As String
Dim vysledek As Variant
Dim Seznam As Excel.Worksheet
Dim PS As Integer
Dim y As Long

Set Seznam = ThisWorkbook.Worksheets("Ridici")
' number of items in the column
PS = Seznam.Cells(Rows.Count, 11).End(xlUp).Row

With Seznam
    For y = 4 To PS
    '  Name of attachment
    Nazev = .Cells(y, 12).Value
    '  selected email
    strEmpfaenger1 = .Cells(y, 15).Value
    strBetr = .Range("O1")
    strBody = .Range("O2")

     strTh = "C:\Users\alois.konecny\AppData\Local\Mozilla Thunderbird\thunderbird.exe"
    '  path to attachment
        cesta = .Range("N1")
    '   attachment including path
    priloha = "\" & Nazev & ".xls"
    vysledek = cesta & priloha
    strFile2 = vysledek
    strCommand = strCommand & " -compose " & "to=" & Chr(34) & strEmpfaenger1 & Chr(34)
    strCommand = strCommand & ",subject=" & Chr(34) & strBetr &  Chr(34)
    strCommand = strCommand & ",body=" & Chr(34) & strBody & Chr(34)
    strCommand = strCommand & ",attachment=" & "file:///" & Replace(strFile2, "\", "/")
    Shell strTh & strCommand, vbNormalFocus
    Next y

End With
End Sub  

---

$

代码有点难读，但您是否尝试过以下方法：

Option Explicit  
Sub SendMailThunder_Click()  
Dim strEmpfaenger1 As String  
Dim strBetr As String  
Dim strBody As String  
Dim strFile2 As Variant  
Dim strTh As String  
Dim strCommand As Variant  
Dim Nazev As String
Dim vysledek As Variant
Dim Seznam As Excel.Worksheet
Dim PS As Integer
Dim y As Long

Set Seznam = ThisWorkbook.Worksheets("Ridici")
' number of items in the column
PS = Seznam.Cells(Rows.Count, 11).End(xlUp).Row

With Seznam
    For y = 4 To PS
    '  Name of attachment
    Nazev = .Cells(y, 12).Value
    '  selected email
    strEmpfaenger1 = .Cells(y, 15).Value
    strBetr = .Range("O1")
    strBody = .Range("O2")

     strTh = "C:\Users\alois.konecny\AppData\Local\Mozilla Thunderbird\thunderbird.exe"
    '  path to attachment
        cesta = .Range("N1")
    '   attachment including path
    priloha = "\" & Nazev & ".xls"
    vysledek = cesta & priloha
    strFile2 = vysledek
    strCommand = strCommand & " -compose " & "to=" & Chr(34) & strEmpfaenger1 & Chr(34)
    strCommand = strCommand & ",subject=" & Chr(34) & strBetr &  Chr(34)
    strCommand = strCommand & ",body=" & Chr(34) & strBody & Chr(34)
    strCommand = strCommand & ",attachment=" & "file:///" & Replace(strFile2, "\", "/")
    Shell strTh & strCommand, vbNormalFocus
    Next y

End With
End Sub  

file://

而不是

file:///  

---

请把你的问题格式化好

@pnuts-谢谢您的编辑

大家好，还有其他建议吗？

@Bas Verlaat-谢谢您的建议。我试过了，但还是不行