我的 Outlook 签名 Outlook 与 VBA 的问题
[英]problem with my outlook signature outlook with VBA
问题描述
我刚开始学 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") & "\Microsoft\Signatures\"
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
1 个解决方案
解决方案1
0 2020-04-23 18:53:16
这可能会偶然发现要更改的代码。
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") & "\Microsoft\Signatures\"
' 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
将签名插入 Outlook email 从 Excel Z6E3EC7E6A9F6007B09838FC0EEZ93A
[英]Inserting Signature into Outlook email from Excel VBA
生成从excel / vba到outlook的电子邮件时，我的电子邮件签名不会出现？
[英]My email signature will not appear when generating an email from excel/vba to outlook?
声明:本站的技术帖子网页，遵循CC BY-SA 4.0协议，如果您需要转载，请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.