Code help

I have the following Code.

[VBA]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"
'.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
[/VBA]

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.

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

It gives me a Run-Time error '1004'

Method 'SaveAs' of Object '_Workbook' failed

Any Ideas what's the cause?

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.

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...

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

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

[/VBA]

B12 is a name the user enters in the form.

...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

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

AB484J01 Server Form.xlsx

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.

every user is using 2007

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

[vba]

<snip>

Next y
ActiveSheet.Copy

'//Stop here

Set Wb = ActiveWorkbook
Wb.SaveAs SaveName
Wb.ChangeFileAccess xlReadOnly
[/vba]

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:

[vba]

<snip>

Next y
ActiveSheet.Copy
Set Wb = ActiveWorkbook

'//Here
msgbox (SaveName)

Wb.SaveAs SaveName

Wb.ChangeFileAccess xlReadOnly
[/vba]


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

[vba]

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"
'.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

[/vba]