VBA Mails workbook as attachment - need to remove path from filename

[Rick Crucial]

Hi, I have a workbook that is completed by "User A" as a form, then by activating a macro through a button is sent to a nominated email address via Outlook to "User B". That part works fine.


'Save the new workbook/Mail it/Delete it

TempFilePath = Environ$("temp") & "\"
TempFileName = "PCR Submission " & ActiveSheet.Range("J18").Text & " " & Format(Now, "mm-dd-yy")


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = Range("G49")
.CC = Range("D52") & ";" & Range("D53") & ";" & Range("D55") & ";" & Range("D56") & ";" & Range("D57") & ";" & Range("D58")
.Subject = "Project Completion Review Submission" & " - " & Range("E22")
.HTMLBody = body of email removed
.Attachments.Add Destwb.FullName
.Send
End With
On Error GoTo 0
.Close savechanges:=False
End With


The problem occurs with the next step which is the recipient either approving or rejecting it via a very similar macro to the one above. It appears that because the attached file contains the file full name including path it produces an error because the recipient cannot access that path (the temp directory for each user has a path that contains that users unique ID).
eg D:\112233\\PCR Submission 71043 04-16-15 (2).xlsm

112233 is the User ID
PCR Submission 71043 04-16-15 (2).xlsm is the Filename

When I created the form and tested each step, it works fine, presumably because I can access my own filepath to the temp folder.



Any suggestions how I can save the file temporarily to email it but then email it as an attachment without the 'FullName'

[Kenneth Hobs]

Maybe environment variables username or temp might help. e.g.

MsgBox Environ("temp")

[Rick Crucial]

Here is the code for the "Acceptance' Button to be used by the recipient of the WB received from above. Perhaps that is where the problem can be fixed?

Sub Button8_Click()


'Advises acceptance of PCR to Project Manager
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object


With Application
.ScreenUpdating = False
.EnableEvents = False
End With


Set Sourcewb = ActiveWorkbook


'Copy the ActiveSheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook


'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2013
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End With




'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "PCR Acceptance " & ActiveSheet.Range("J18").Text & " " & Format(Now, "mm-dd-yy")


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = Range("D53")
.CC = Range("D52") & ";" & Range("G47") & ";" & Range("D55") & ";" & Range("D56") & ";" & Range("D57") & ";" & Range("D58")
.Subject = "Project Completion Review Acceptance" & "- " & Range("E22")
.HTMLBody = "Hi,<br><br> The attached PCR Form has been <b> approved </b> by the Business Owner. <br><br> <b> Project Name: </b>" & Range("E22") & "<br><br><b>Project Server ID: </b>" & Range("J18") & "<br><br><b>Project SAP ID: </b>" & Range("E18") & "<br><br>ACTION REQUIRED: Project Manager to save in Project Site as closure documentation" & "<br><br>Thank You<br><br><br>"
.Attachments.Add Destwb.FullName
.Send
End With
On Error GoTo 0
.Close savechanges:=False
End With


'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr


Set OutMail = Nothing
Set OutApp = Nothing


With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

[Rick Crucial]

I'm wondering if by changing Environ$(temp) (in Filepath) to "H:" - because all users in the company have an H: drive that may get around the problem. Will try.

[Rick Crucial]

I'm wondering if by changing Environ$(temp) (in Filepath) to "H:" - because all users in the company have an H: drive that may get around the problem. Will try.

Nope. It still seems to want to reference the saved and deleted WB from the first macro and the H drive is also User specific.

[Kenneth Hobs]

Please use code tags when you paste code. Click the # icon in the toolbar to add them or type (code)MsgBox "hi"(/code) where you replace ()'s with []'s.

I am confused about what the error is. When you attach a file in an e-mail, when opened from the e-mail, it opens into the user's temp folder. Some programs do not perform properly when opened that way. In those cases, simply tell the users to Save the file and then Open it from the saved location, not from the e-mail program.

Of course your code should reference ThisWorkbook object rather than setting a reference using a hard coded filename. If you have external file references and the end user does not have access to those drives and/or folders, things can go amiss.

You would probably be better making a copy of the current file and renaming (Name) it if needed rather than using SaveAs. Here is one thread that used CopyFile. http://www.vbaexpress.com/forum/archive/index.php/t-34223.html