Fromフィールドを選択した後、または返信をクリックした後に署名を設定するマクロを作成しています。私の問題は、From フィールドの値を取得する方法がわからないことです。このフィールドを設定する方法を知っています。
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(Mailbox As String) As String
Dim Signature As String
Dim SigStringPL As String
Dim SigStringUK As String
SigStringPL = Environ("appdata") & _
"\Microsoft\Signatures\Poland.htm"
SigStringUK = Environ("appdata") & _
"\Microsoft\Signatures\United Kingdom.htm"
If Mailbox = "poland@poland.pl" Then
If Dir(SigStringPL) <> "" Then
GetSignature = GetBoiler(SigStringPL)
Else
GetSignature = ""
End If
Else
If Dir(SigStringUK) <> "" Then
GetSignature = GetBoiler(SigStringUK)
Else
GetSignature = ""
End If
End If
End Function
Sub Mail_Outlook_With_Signature_Plain()
' Don't forget to copy the function GetBoiler in the module.
' Working in Office 2000-2010
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim Signature As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "content"
Signature = GetSignature("erni@erni.pl")
MsgBox (OutMail.SentOnBehalfOfName)
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.subject = "This is the Subject line"
.HTMLBody = strbody & "<br><br>" & Signature
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
よろしく、エルニ