我刚开始使用VBA。我创建了一个vba代码来通过Outlook发送电子邮件。然而，当打开邮件时，代码是有效的，徽标在一秒钟内出现和消失，取而代之的是一个红十字。我不明白问题出在哪里。这是我的代码：
Private Sub EnvoyerMail()
Dim Mail As Variant
Dim Ligne As Integer
Dim Nom_Fichier As String
Dim DernLigne As Long
Dim SigString As String
Dim Signature As String
Dim strBody As String
Set Mail = CreateObject("Outlook.Application")
DernLigne = Range("A1048576").End(xlUp).Row
For Ligne = 2 To 3 'DernLigne ' A changer selon la taille du fichier
'Change only Mysig.htm to the name of your signature
SigString = Environ("appdata") & "MicrosoftSignatures"
f = Dir(SigString & "*.htm")
If f <> "" Then
Signature = GetBoiler(SigString & f)
Signature = Replace(Signature, "src=""", "src=""" & SigString)
Else
Signature = ""
End If
On Error Resume Next
With Mail.CreateItem(olMailItem)
'.HTMLBody = Signature
strBody = _
"<Body>Bonjour,<br /><br /></Body>" & _
"<Body>Veuillez trouver ci-joint le rapport énergétique du mois dernier pour votre site.<br /><br /> Nous vous enverrons de manière régulière des rapports.<br />Notre objectif est de maintenir en continu un équilibre entre économies d’énergie et confort.<br /><br /></Body>" & _
"<Body>Remarque: Ce rapport est créé de façon automatique, si vous remarquez une erreur, n’hésitez pas à nous faire un retour.<br /><br /></Body>"
Nom_Fichier = Range("A" & Ligne) 'Chercher la pièce jointe
.Display
.Save
.Subject = Range("B" & Ligne)
.To = Range("C" & Ligne)
.CC = Range("D" & Ligne)
'.BCC = Range("" & Ligne)
.HTMLBody = strBody & Signature
.Attachments.Add Nom_Fichier
.Display
.Send
End With
Next Ligne
End Sub
Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
Function GetSignature(fPath As String) As String
Dim fso As Object
Dim TSet As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set TSet = fso.GetFile(fPath).OpenAsTextStream(1, -2)
GetSignature = TSet.readall
TSet.Close
End Function
这可能会偶然发现要更改的代码。
Option Explicit
Private Sub EnvoyerMail_Signature_Then_EditedSignature_Demo()
' Excel code and loop not needed for this demo
Dim Mail As Object
Dim SigString As String
Dim Signature As String
Dim strBody As String
Dim F As String
Set Mail = CreateObject("Outlook.Application")
SigString = Environ("appdata") & "MicrosoftSignatures"
' Change only Mysig.htm to the name of your signature
' F = dir(SigString & "Mysig.htm")
' With the * wildcard it is too vague if more than one signature
F = dir(SigString & "*.htm")
If F <> "" Then
' signature of unknown composition
Signature = GetBoiler(SigString & F)
' edited signature of unknown composition
Signature = Replace(Signature, "src=""", "src=""" & SigString)
Else
Signature = ""
End If
' Default signature
With Mail.CreateItem(olMailItem)
.Display
MsgBox "Mail #1 - Default signature" & vbCr & vbCr & "Default signature displays and becomes part of .HTMLBody"
strBody = _
"<Body>Bonjour,<br /><br /></Body>" & _
"<Body>Veuillez trouver ci-joint le rapport ?nerg?tique du mois dernier pour votre site.<br /><br /> Nous vous enverrons de mani?re r?guli?re des rapports.<br />Notre objectif est de maintenir en continu un ?quilibre entre ?conomies d??nergie et confort.<br /><br /></Body>" & _
"<Body>Remarque: Ce rapport est cr?? de fa?on automatique, si vous remarquez une erreur, n?h?sitez pas ? nous faire un retour.<br /><br /></Body>"
' Ignore edited F = dir(SigString ...
' Overwrite body, which is currently the default signature, with strBody and current .HTMLBody
.HTMLBody = strBody & .HTMLBody
MsgBox "Mail #1 - Default signature" & vbCr & vbCr & _
"Entire body, including default signature, overwritten by strBody and current .HTMLBody"
End With
' Edited F = dir(SigString ...
With Mail.CreateItem(olMailItem)
.Display
MsgBox "Mail #2 - Edited F = dir(SigString ..." & vbCr & vbCr & "Default signature displays and becomes part of .HTMLBody"
strBody = _
"<Body>Bonjour,<br /><br /></Body>" & _
"<Body>Veuillez trouver ci-joint le rapport ?nerg?tique du mois dernier pour votre site.<br /><br /> Nous vous enverrons de mani?re r?guli?re des rapports.<br />Notre objectif est de maintenir en continu un ?quilibre entre ?conomies d??nergie et confort.<br /><br /></Body>" & _
"<Body>Remarque: Ce rapport est cr?? de fa?on automatique, si vous remarquez une erreur, n?h?sitez pas ? nous faire un retour.<br /><br /></Body>"
' Overwrite body, which is currently the signature, with strBody and edited F = dir(SigString ...
.HTMLBody = strBody & Signature
MsgBox "Mail #2 - Edited F = dir(SigString ..." & vbCr & vbCr & _
"Entire body, including default signature, overwritten by strBody and edited version of signature found by" & vbCr & vbCr & _
" F = dir(SigString ..." & vbCr & vbCr & _
"dir(SigString ... is not necessarily the same as the default signature if there is more than one signature."
End With
End Sub
Function GetBoiler(ByVal sFile As String) As String
Dim FSO As Object
Dim ts As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ts = FSO.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.ReadAll
ts.Close
End Function
Function GetSignature(fPath As String) As String
Dim FSO As Object
Dim TSet As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TSet = FSO.GetFile(fPath).OpenAsTextStream(1, -2)
GetSignature = TSet.ReadAll
TSet.Close
End Function