Ik heb het volgende script om mijn blad als bijlage met een mail te zenden. Het probleem is echter dat het script eerst het blad moet opslaan en dan krijg je zo´n waarschuwings bericht. Dat bericht wil ik graag niet meer te zien krijgen. Weet iemand misschien hoe ik het script moet wijzigen om geen messagebox meer te krijgen.
Sub CDO_Send_ActiveSheet_Body()
' This example use late binding, you don't have to set a reference
' You must be online when you run the sub
Dim iMsg As Object
Dim iConf As Object
' Dim Flds As Variant
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
' .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
' .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill in your SMTP server here"
' .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With
'Check out the Tips section if you want to change the .To and .TextBody
With iMsg
Set .Configuration = iConf
.To = "Jon@something.com"
.CC = ""
.BCC = ""
.From = """Ron"" <ron@something.nl>"
.Subject = "This is a test"
.HTMLBody = SheetToHTML(ActiveSheet)
.Send
End With
Set iMsg = Nothing
Set iConf = Nothing
End Sub
Public Function SheetToHTML(sh As Worksheet)
'Function from Dick Kusleika his site
'http://www.dicks-clicks.com/excel/sheettohtml.htm
'Changed by Ron de Bruin 04-Nov-2003
Dim TempFile As String
Dim Nwb As Workbook
Dim myshape As Shape
Dim fso As Object
Dim ts As Object
sh.Copy
Set Nwb = ActiveWorkbook
For Each myshape In Nwb.Sheets(1).Shapes
myshape.Delete
Next
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
Nwb.SaveAs TempFile, xlHtml
Nwb.Close False
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
SheetToHTML = ts.ReadAll
ts.Close
Set ts = Nothing
Set fso = Nothing
Set Nwb = Nothing
Kill TempFile
End Function
Sub CDO_Send_ActiveSheet_Body()
' This example use late binding, you don't have to set a reference
' You must be online when you run the sub
Dim iMsg As Object
Dim iConf As Object
' Dim Flds As Variant
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
' .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
' .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill in your SMTP server here"
' .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With
'Check out the Tips section if you want to change the .To and .TextBody
With iMsg
Set .Configuration = iConf
.To = "Jon@something.com"
.CC = ""
.BCC = ""
.From = """Ron"" <ron@something.nl>"
.Subject = "This is a test"
.HTMLBody = SheetToHTML(ActiveSheet)
.Send
End With
Set iMsg = Nothing
Set iConf = Nothing
End Sub
Public Function SheetToHTML(sh As Worksheet)
'Function from Dick Kusleika his site
'http://www.dicks-clicks.com/excel/sheettohtml.htm
'Changed by Ron de Bruin 04-Nov-2003
Dim TempFile As String
Dim Nwb As Workbook
Dim myshape As Shape
Dim fso As Object
Dim ts As Object
sh.Copy
Set Nwb = ActiveWorkbook
For Each myshape In Nwb.Sheets(1).Shapes
myshape.Delete
Next
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
Nwb.SaveAs TempFile, xlHtml
Nwb.Close False
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
SheetToHTML = ts.ReadAll
ts.Close
Set ts = Nothing
Set fso = Nothing
Set Nwb = Nothing
Kill TempFile
End Function
