Code help

[Emoncada]

I have the following Code.


Option Explicit

Sub eMailActiveWorksheet()
Dim OL As Object
Dim EmailItem As Object
Dim Wb As Workbook
Dim WbName As String
Dim FileName As String
Dim y As Long
Dim TempChar As String
Dim SaveName As String
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(0)
FileName = Range("B12").Value & " Server Form"
For y = 1 To Len(FileName)
TempChar = Mid(FileName, y, 1)
Select Case TempChar
Case Is = "/", "\", "*", "?", """", "<", ">", "|", ":"
Case Else
SaveName = SaveName & TempChar
End Select
Next y
ActiveSheet.Copy
Set Wb = ActiveWorkbook
Wb.SaveAs SaveName
Wb.ChangeFileAccess xlReadOnly
With EmailItem
.Subject = "Server Form - " & Range("B12").Value
.Body = "Server Form Attached" ' & vbCrLf & _
"Line 2" & vbCrLf & _
"Line 3"
.To = "johndoe@abc123.com (johndoe@abc123.com)"
'.CC = ""
'.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
.Attachments.Add Wb.FullName
.Send
End With
WbName = Wb.FullName
Wb.Close False
Set Wb = Nothing
Set OL = Nothing
Set EmailItem = Nothing
Kill WbName
Application.ScreenUpdating = True
End Sub


This works Great on my computer but If I go to another computer and us the same form that calls this it gives me a run time error.

It can't save it. Can anyone see why it does that?

It highlights the "Wb.SaveAs SaveName"

Now I don't need to save this just email it, but I believe it saves it temporarly to email it.

[Bob Phillips]

What error is it giving, and what value is in SaveName when it fails?

[Emoncada]

It gives me a Run-Time error '1004'

Method 'SaveAs' of Object '_Workbook' failed

[Emoncada]

Any Ideas what's the cause?

[mikerickson]

One guess would be that B12 holds a file path that matches the file structure of one of your computers, but doesn't match the other.

[rbrhodes]

Hi E,

The second part of the question was "What value is Savename when it fails?"

You're using a list of 9 items to find illegal filename chars. That's one more than the MS Error dialog gives but less than all possibles. I use a list of 14 that I built from scouring the Web (lots of varying answers from different people using different software)

I'm including my list here. It adds ; [ ] = +

The square brackets are a definite the others are possibles...



Case Is = "/", "\", "*", "?", """", "<", ">", "|", ":"
Case Is = "/", "\", "*", "?", """", "<", ">", "|", ":", ";", "[", "]", "=", "+"

[Emoncada]

B12 is a name the user enters in the form.

[rbrhodes]

...but whats the value of SaveName when the code stops?

It will appear in the 'Locals' window or when you put the cursor on it or use debug print... That's the key I think

[Emoncada]

It works fine on my Desktop and it saves the file name like this.

AB484J01 Server Form.xlsx

[austenr]

What version is the other computer running? It looks like you are using 2007 and the other user is using 2003 more than likely. 2003 does not recognize that file extension so it throws that error. Just a guess.

[Emoncada]

every user is using 2007

[rbrhodes]

No answer...

Emoncada,

1) Can you make this happen at will?

2) Do you know how to step through the code?

If yes to both of the above then step through till you get to the end of the loop



<snip>
Next y
ActiveSheet.Copy
'//Stop here
Set Wb = ActiveWorkbook
Wb.SaveAs SaveName
Wb.ChangeFileAccess xlReadOnly


and look in the Locals window for the value of 'SaveName'


Alternatively you could add a message box to the code to tell you the name:



<snip>
Next y
ActiveSheet.Copy
Set Wb = ActiveWorkbook
'//Here
msgbox (SaveName)
Wb.SaveAs SaveName
Wb.ChangeFileAccess xlReadOnly



If you can't recreate the error at will then allow the error and trap it.




Option Explicit

Sub eMailActiveWorksheet()
Dim OL As Object
Dim EmailItem As Object
Dim Wb As Workbook
Dim WbName As String
Dim FileName As String
Dim y As Long
Dim TempChar As String
Dim SaveName As String
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(0)
FileName = Range("B12").Value & " Server Form"
For y = 1 To Len(FileName)
TempChar = Mid(FileName, y, 1)
Select Case TempChar
Case Is = "/", "\", "*", "?", """", "<", ">", "|", ":"
Case Else
SaveName = SaveName & TempChar
End Select
Next y
ActiveSheet.Copy
Set Wb = ActiveWorkbook
'//Here
On Error Resume Next
Err.clear
Wb.SaveAs SaveName
If Err<>0 then
msgbox(savename)
goto exithere
End if
'//To here (Plus label below)
Wb.ChangeFileAccess xlReadOnly
With EmailItem
.Subject = "Server Form - " & Range("B12").Value
.Body = "Server Form Attached" ' & vbCrLf & _
"Line 2" & vbCrLf & _
"Line 3"
.To = "johndoe@abc123.com (johndoe@abc123.com)"
'.CC = ""
'.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
.Attachments.Add Wb.FullName
.Send
End With
'//Added
EXITHERE:
WbName = Wb.FullName
Wb.Close False
Set Wb = Nothing
Set OL = Nothing
Set EmailItem = Nothing
Kill WbName
Application.ScreenUpdating = True
End Sub