G
Guest
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"" <[email protected]>" 'I input actual, to
me & from me
.CC = ""
.BCC = ""
.Subject = "ERROR FILE from " & Sheets("Setup").Range("H6")
'identifies the username
.From = """ERROR FILE"" <[email protected]>" '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
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"" <[email protected]>" 'I input actual, to
me & from me
.CC = ""
.BCC = ""
.Subject = "ERROR FILE from " & Sheets("Setup").Range("H6")
'identifies the username
.From = """ERROR FILE"" <[email protected]>" '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