I setup a macro that would allow a user to send a copy of the entire workbook
to me should it malfunction so I can try to duplicate their problem. The
code works great to save a copy, send it via CDO, then delete the copy, but
when I try to open the copy, it is read only. I checked the properties of
the document, and unbocked it, it's still read only, the read only box was
not checked in the properties either. I cannot open the file at all. Here's
the code:
'Sub Email()
Dim iMsg As Object
Dim iConf As Object
Dim Cell As Range
Dim Reply As String
Dim wb As Workbook
Dim WBname As String
' Dim Flds As Variant

' 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") =
"smtp.myservername.com" 'I input actual
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With
Application.ScreenUpdating = False
Set wb = ActiveWorkbook
Reply = MsgBox("Are you sure you want to send this error file?" & Chr(10),
vbYesNo)
If Reply = vbYes Then
WBname = wb.Name & " " & Format(Now, "mm-dd-yy h-mm") & ".xls"
wb.SaveCopyAs "C:/" & WBname
Set iMsg = CreateObject("CDO.Message")
With iMsg
Set .Configuration = iConf
.To = """Mike"" " 'I input actual, to
me & from me
.CC = ""
.BCC = ""
.Subject = "ERROR FILE from " & Sheets("Setup").Range("H6")
'identifies the username
.From = """ERROR FILE"" " 'I input
actual, to me & from me
' Set importance or Priority to high
.Fields("urn:schemas:httpmail:importance") = 2
.Fields("urn:schemas:mailheader:X-Priority") = 1
' Update fields
.Fields.Update
.AddAttachment "C:/" & WBname
.Send
Kill "C:/" & WBname
Set iMsg = Nothing
Set iConf = Nothing
Set wb = Nothing
Application.ScreenUpdating = True
End With
End If
End Sub
'
Any help is appreciated!

Mike

Hi Mike

From my site

Don't remove the TextBody line in the code. If you do you can't open the attachment (bug in CDO).
If you don't want to have text in the body use this then .TextBody = ""


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"mikeolson" wrote in message ...
I setup a macro that would allow a user to send a copy of the entire workbook
to me should it malfunction so I can try to duplicate their problem. The
code works great to save a copy, send it via CDO, then delete the copy, but
when I try to open the copy, it is read only. I checked the properties of
the document, and unbocked it, it's still read only, the read only box was
not checked in the properties either. I cannot open the file at all. Here's
the code:
'Sub Email()
Dim iMsg As Object
Dim iConf As Object
Dim Cell As Range
Dim Reply As String
Dim wb As Workbook
Dim WBname As String
' Dim Flds As Variant

' 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") =
"smtp.myservername.com" 'I input actual
'
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With
Application.ScreenUpdating = False
Set wb = ActiveWorkbook
Reply = MsgBox("Are you sure you want to send this error file?" & Chr(10),
vbYesNo)
If Reply = vbYes Then
WBname = wb.Name & " " & Format(Now, "mm-dd-yy h-mm") & ".xls"
wb.SaveCopyAs "C:/" & WBname
Set iMsg = CreateObject("CDO.Message")
With iMsg
Set .Configuration = iConf
.To = """Mike"" " 'I input actual, to
me & from me
.CC = ""
.BCC = ""
.Subject = "ERROR FILE from " & Sheets("Setup").Range("H6")
'identifies the username
.From = """ERROR FILE"" " 'I input
actual, to me & from me
' Set importance or Priority to high
.Fields("urn:schemas:httpmail:importance") = 2
.Fields("urn:schemas:mailheader:X-Priority") = 1
' Update fields
.Fields.Update
.AddAttachment "C:/" & WBname
.Send
Kill "C:/" & WBname
Set iMsg = Nothing
Set iConf = Nothing
Set wb = Nothing
Application.ScreenUpdating = True
End With
End If
End Sub
'
Any help is appreciated!

Mike

Thanks Ron! Works perfect now!

Mike

"Ron de Bruin" wrote:

Hi Mike

From my site

Don't remove the TextBody line in the code. If you do you can't open the attachment (bug in CDO).
If you don't want to have text in the body use this then .TextBody = ""


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"mikeolson" wrote in message ...
I setup a macro that would allow a user to send a copy of the entire workbook
to me should it malfunction so I can try to duplicate their problem. The
code works great to save a copy, send it via CDO, then delete the copy, but
when I try to open the copy, it is read only. I checked the properties of
the document, and unbocked it, it's still read only, the read only box was
not checked in the properties either. I cannot open the file at all. Here's
the code:
'Sub Email()
Dim iMsg As Object
Dim iConf As Object
Dim Cell As Range
Dim Reply As String
Dim wb As Workbook
Dim WBname As String
' Dim Flds As Variant

' 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") =
"smtp.myservername.com" 'I input actual
'
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With
Application.ScreenUpdating = False
Set wb = ActiveWorkbook
Reply = MsgBox("Are you sure you want to send this error file?" & Chr(10),
vbYesNo)
If Reply = vbYes Then
WBname = wb.Name & " " & Format(Now, "mm-dd-yy h-mm") & ".xls"
wb.SaveCopyAs "C:/" & WBname
Set iMsg = CreateObject("CDO.Message")
With iMsg
Set .Configuration = iConf
.To = """Mike"" " 'I input actual, to
me & from me
.CC = ""
.BCC = ""
.Subject = "ERROR FILE from " & Sheets("Setup").Range("H6")
'identifies the username
.From = """ERROR FILE"" " 'I input
actual, to me & from me
' Set importance or Priority to high
.Fields("urn:schemas:httpmail:importance") = 2
.Fields("urn:schemas:mailheader:X-Priority") = 1
' Update fields
.Fields.Update
.AddAttachment "C:/" & WBname
.Send
Kill "C:/" & WBname
Set iMsg = Nothing
Set iConf = Nothing
Set wb = Nothing
Application.ScreenUpdating = True
End With
End If
End Sub
'
Any help is appreciated!

Mike