I have a VBS script which I am using for Automation. Every week it pulls most recent information from a database (most recent data is queried in database) I have the queries that get the most recent data sets (there are 2 of them), I have a function which creates the email, The only problem is that the output from the function that returns an array of the data is not outputting in a type, therefore I get a type error.
Script file and sample database are in hyperlinks at bottom of post.
Below is my code:
Class Email
Private toccbcc
Private ttl
Private htmlb1,htmlb2,htmlb3
Private Sub Class_Initialize()
toccbcc="[email protected]
htmlb1= "<html><body><p>" & _
"<table cellspacing=""0"" cellpadding=""0"" width=""630"" align=""left"" border=""0"" style=""border-collapse:collapse"">" & _
"<font size=""6""> <tr><td rowspan=""2"" style=""text-align:center; border:1px solid #000000; border-bottom:3px solid #000000;"" width=""105"">Type</td><td colspan=""2"" style=""text-align:center; border:1px solid #000000; border-bottom:line-height=1.8em, solid #000000;"" width=""105"">v2</td><td colspan=""2"" style=""text-align:center; border:1px solid #000000; border-bottom:line-height=1.8em solid #000000;"" width=""105"">v2</td></tr></font>"
htmlb3="<br><br>Thank you,<br>Name</p></body></html>"
ttl = DateValue(CStr(Now())) & " => " & DateValue(CStr(Now() + 6)) & " Type Pricing"
htmlb2=""
End Sub
Private Sub Class_Terminate()
End Sub
Public Sub SetHTMLTableBody(tmp)
For i=0 To UBound(tmp)
If I = 0 Then
htmlb2 = htmlb2 & "<font size=""4"">"
End If
For j=0 To UBound(tmp,2)
If (TMP(I,J) <> "") Then
If (I = 1) Then
htmlb2 = htmlb2 & "<td style=""text-align:center; border:1px solid #000000; border-bottom:3px solid #000000;"" width=""105"">"
Else
htmlb2 = htmlb2 & "<td style=""text-align:center; border:1px solid #000000; border-bottom:line-height=1.8em"" width=""105"">"
End If
If (I = 0) Then
htmlb2 = htmlb2 & "<b>" & TMP(I,J) & "</b>"
Else
htmlb2 = htmlb2 & TMP(I,J)
End If
htmlb2 = htmlb2 & "</td>"
End If
Next
If I = 1 Then
htmlb2 = htmlb2 & "</font>"
End If
htmlb2 = htmlb2 & "</tr>"
Next
End sub
Public Property Get HTMLBODY()
htmlbody=htmlb1&htmlb2&htmlb3
End Property
Public Property Get ToCC()
ToCC=toccbcc
End Property
Public Property Get Title()
Title=ttl
End property
End Class
Class Emailer
Dim objoutlook
Dim tmpmi
Dim eml
'Dim WshShell
Private Sub Class_Initialize()
'Set WshShell=WScript.CreateObject("WScript.shell")
'WshShell.Run "Outlook.exe"
Set objoutlook=CreateObject("Outlook.application")
WScript.Sleep 2000
End Sub
Private Sub Class_Terminate()
objoutlook.Quit
Set objoutlook=Nothing
Set eml=Nothing
Set tmpmi=Nothing
End Sub
Public Property Set Email(em)
Set eml=em
End Property
Public Sub SendEmail()
Set tmpmi=objoutlook.CreateItem(0)
With tmpmi
.To=eml.ToCC()
.Subject=eml.Title()
.HTMLBody=eml.HTMLBODY()
.ReadReceiptRequested = False
.Send
End with
End Sub
End Class
Public Sub RunEmailer()
Dim objaccess
Dim objoutlook
Dim WshShell
'Set WshShell=WScript.CreateObject("WScript.shell")
'WshShell.Run "Outlook.exe"
'WScript.Sleep 2000
Set objaccess=CreateObject("Access.Application")
objaccess.Visible=False
objaccess.OpenCurrentDatabase("...\SampleDatabase.accdb")
Dim eml
Dim emlr
Set emlr=New emailer
Set eml = New Email
Set emlr.Email=eml
eml.SetHTMLTableBody objaccess.Run("GetURV")
WScript.Sleep 2000
objaccess.CloseCurrentDatabase
objaccess.Quit
Set objaccess=Nothing
'Set emlr.Email=eml
'emlr.SendEmail
Set eml=Nothing
Set emlr=Nothing
End Sub
RunEmailer()
The problem is with the tmp() in SetHTMLTableBody(tmp) The first error I found, which prevents continuing is fount at the line If (TMP(I,J) <> "") Then. It considers what ever is returned to be an invalid data type. I have tried casting and nothing. whatever type it is being read as needs to be converted to a string because it will eventually go into an html body.
I have a version that is currently working, but it is not really efficient, and occasionally stops. My current process is below
The reason for wanting to send the message through vbs and not access is because outlook is closed through vbs, not access, therefore if the message isn't sent when when script tells outlook to close, Outlook brings up error message.
Also to lower CPU Usage (only one program open at a time).
The reason for using outlook is because this message is being sent to someone on the same email server. Below are files that can be grabbed to test with.
Outlook.Applicationwhen you could just useCDONTSand avoid opening Outlook completely and send via SMTP?tmptype is 8200