VBScript Automate create form and attach file email and display default email signature, outlook.
Option Explicit
Sub SendEmail()
Dim strTo
Dim strCC
Dim strSubject
Dim strBody
Dim strAttachmentPath1
Dim strAttachmentPath2
strTo = "recipient@example.com"
strCC = "cc@example.com"
strSubject = "ทดสอบ Subject of the email"
strBody = "ทดสอบ" & vbCrLf & "Additional body text."
strAttachmentPath1 = "C:\Users\path\Desktop\test1.txt"
strAttachmentPath2 = "C:\Users\path\Desktop\test2.txt"
If SendActiveWorkbook(strTo, strSubject, strCC, strBody, strAttachmentPath1, strAttachmentPath2) Then
MsgBox "Email creation success"
Else
MsgBox "Email creation failed!"
End If
End Sub
' Function to send email
Function SendActiveWorkbook(strTo, strSubject, strCC, strBody, strAttachmentPath1, strAttachmentPath2)
On Error Resume Next
Dim appOutlook
Dim mItem
Dim Head
Dim Signature
Dim bodyTag
Dim PosBody
Dim pTag
Dim PosSignature
' Create a new instance of Outlook
Set appOutlook = CreateObject("Outlook.Application")
Set mItem = appOutlook.CreateItem(0)
With mItem
.Display ' Display the email (important step)
' Split the HTMLBody into Head and Signature
.To = strTo
.CC = strCC
.Subject = strSubject
bodyTag = "<body"
PosBody = InStr(.HTMLBody, bodyTag)
pTag = "<o:p>"
PosSignature = InStr(PosBody, .HTMLBody, pTag)
Head = Left(.HTMLBody, PosSignature - 1)
Signature = Mid(.HTMLBody, PosSignature)
' Now you can add your custom HTML text between Head and Signature
.HTMLBody = Head & strBody & Signature
' Attach the files
If strAttachmentPath1 <> "" Then .Attachments.Add strAttachmentPath1
If strAttachmentPath2 <> "" Then .Attachments.Add strAttachmentPath2
' Send the email
'.Send '(หากต้องการให้ส่ง email เลยเอา ' ออก)
End With
' Clean up objects
Set mItem = Nothing
Set appOutlook = Nothing
' Assuming success if no error occurred
If Err.Number = 0 Then
SendActiveWorkbook = True
Else
SendActiveWorkbook = False
End If
End Function
' Function to display a message box
Sub MsgBox(message)
Dim wshell
Set wshell = CreateObject("WScript.Shell")
wshell.Popup message
Set wshell = Nothing
End Sub
' Call the main subroutine
SendEmail()
0 ความคิดเห็น