Macro to attach workbook to email

[Knyte]

Hi

I have a macro which works fine for me and everyone in my office building. However when people outside of the office building attempts it, it returns a Runtime Error 1004.

What I am trying to do is when a user clicks on a 'Send' button, the code behind it will open up outlook and start a new email page. It will also save and attach the workbook.

As mentioned, works perfectly for me but not anyone else outside of my office building. Any thoughts on why this may be?

The code I have used below (I have a feeling it has something to do with it saving to the desktop first. If anyone can provide a code where it just simply attaches the document to the email, would be much appreciated and hopefully will solve my issue):

Sub Send_By_Email()

Dim OlApp As New Outlook.Application
Dim myNameSp As Outlook.Namespace
Dim myInbox As Outlook.MAPIFolder
Dim myExplorer As Outlook.Explorer
Dim NewMail As Outlook.MailItem
Dim OutOpen As Boolean
Dim WB As Workbook
Dim Desktop, book As String

Desktop = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator
book = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
book = book & " - Conflict Form.xls"
ThisWorkbook.SaveCopyAs Desktop & book

' Code to check if Outlook is already Open. If it's not, to open a new one
OutOpen = True
Set myExplorer = OlApp.ActiveExplorer
If TypeName(myExplorer) = "Nothing" Then
OutOpen = False
Set myNameSp = OlApp.GetNamespace("MAPI")
Set myInbox = myNameSp.GetDefaultFolder(olFolderInbox)
Set myExplorer = myInbox.GetExplorer
End If

'Create a new mail message item.
Set NewMail = OlApp.CreateItem(olMailItem)
With NewMail
.Display
.Subject = "Conflict of Interest Form - Completed - " & Range("E26") & ": " & Range("E23")
.To = abc@def.com.au
.Attachments.Add Desktop & book
End With

If Not OutOpen Then OlApp.Quit
Set OlApp = Nothing
Set myNameSp = Nothing
Set myInbox = Nothing
Set myExplorer = Nothing
Set NewMail = Nothing
Kill Desktop & book

End Sub

 

[Andrew Poulsom]

On which line did you get the error and how was it worded?

 

[Knyte]

Hmmm...not sure which line the error occurs as i am unable to reproduce the error on my end.

The user did send me a screen shot of the error and it reads:

"Run-time error '1004':

Method 'SaveCopyAs' of object'_workbook' failed

With that message i'm assuming it has something to do with when the code tried to save the workbook onto the desktop.

 

[G2K]

yes, i had this problem earlier you can use timestamp along with name to fix it. Like Filename & Vba.now or a changing number every time the code runs.

The problem arise when user want to save the file with same name in same path and code througs up and Error -1004.

 

[Knyte]

Hi G2K

Do you have an example? I've never heard of timestamp before so unsure what i will need to do to the code.

Thanks

EV

 

[Andrew Poulsom]

Have you tried saving the copy in the same folder as the workbook?

ThisWorkbook.SaveCopyAs ThisWorkbook.Path & Application.PathSeparator & book

 

[Knyte]

Yup tried that as well and they still get the same error.

Even went to basics and checked to see if they were running the same excel version and same scripts etc and can't identify any differences besides the fact that they are on a different site.

 

[G2K]

Try this :

ThisWorkbook.SaveCopyAs ThisWorkbook.Path & Application.PathSeparator & Range("D18").Value & VBA.Right(Format(VBA.Now, "MM:SS"), 1)[

Each time the filename would be diffrent.i can not explain the reason but it's working for me.

 

[Walky]

Hello,

Some months ago, I found (I don't remember where) a macro that allowed me to attach a workbook to an e-mail and send it automatically.

Now, I would like to be able to modify the macro in order to be able to write a comment and maybe add another recipient in the e-mail before sending it.

I presume that a slight modification of the macro in this thread could do the job, but I do not know what to do.

The macro I use is in 2 parts, the 1st one will copy and paste the values on my Workbook, the second (see below) is what I'd like to modify to acheive what I've written above.

Could anyone please help me out?


Dim wb As Workbook
Dim I As Long

Set wb = ActiveWorkbook

If Val(Application.Version) >= 12 Then
If wb.FileFormat = 51 And wb.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file, there will" & vbNewLine & _
"be no VBA code in the file you send. Save the" & vbNewLine & _
"file first as xlsm and then try the macro again.", vbInformation
Exit Sub
End If
End If

On Error Resume Next
For I = 1 To 3
wb.SendMail "someone@somewhere.com", _
"E-mail subject here"
If Err.Number = 0 Then Exit For
Next I
On Error GoTo 0

End Sub


Thanks in advance,

Walky.

 

[Andrew Poulsom]

You will have to use Outlook rather than SendMail:

http://www.rondebruin.nl/mail/folder2/mail1.htm