我的 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.