Save as vba function

  • Thread starter Thread starter alanford
  • Start date Start date
A

alanford

Hi there guys,
I need to achieve a saveas function with vba from a *.xtl
1) Cell c3 contains a text that will act as the file name.
2) the code needs to use this text as file name and save it to a
directory C:\windows\desktop\dummy\.
3) if the file exists then the user needs to be prompted to save or
rename in that directory.

what I have so far is


Workbooks("book1.xtl").SaveAs Filename:="C:\windows\desktop\dummy\" &
Range("c2").Value & ".xls"

the above works fine until the system finds that the filename exists
and instead of asking the user if he wants to save over or change the
name it goes into BREAK mode. Can I get around it?

Thank you again.


Alan
 
You could check for it first and see if it exists.

Option Explicit
Sub testme()

Dim resp As Long
Dim myFileName As String

Dim WSHShell As Object
Dim DesktopPath As String

Set WSHShell = CreateObject("WScript.Shell")
DesktopPath = WSHShell.SpecialFolders("Desktop")
Set WSHShell = Nothing

With Workbooks("book.xlt") '<--- .xtl????

myFileName = DesktopPath & "\dummy\" _
& .Worksheets("sheet1").Range("c2").Value & ".xls"

resp = vbYes
If Dir(myFileName) = "" Then
'doesn't exist
Else
resp = MsgBox(Prompt:="Overwrite the existing file?", _
Buttons:=vbYesNo)
End If

If resp = vbYes Then
Application.Displayalerts = False
.SaveAs Filename:=myFileName, _
FileFormat:=xlWorkbookNormal
Application.Displayalerts = True
Else
MsgBox "File Not Saved!"
End If
End With
End Sub

A couple of questions:

Is that file really named: *.xtl (not *.xlt)?

And what worksheet do you pick up the C2 value from? I used
worksheets("sheet1") inside that book.xlt workbook.

And that WSHShell stuff will give you the name of the Desktop folder--it could
vary with different versions of windows.

The .displayalerts stops excel's "do you want to overwrite?" question from
appearing.
 
Hi Dave,
I thank you for your help but the problem is I tried your code but all
I got was a run-time error 9 subscript out of range. I made very little
changes to your code but is still wont work. Please would you take a
look and see why it won't have it?

Private Sub CommandButton2_Click()

Dim resp As Long
Dim myFileName As String


Dim WSHShell As Object
Dim DesktopPath As String


Set WSHShell = CreateObject("WScript.Shell")
DesktopPath = WSHShell.SpecialFolders("Desktop")
Set WSHShell = Nothing


With Workbooks("book.xlt")


myFileName = DesktopPath & "\recipes\" _
& .Worksheets("costings").Range("c2").Value &
".xls"


resp = vbYes
If Dir(myFileName) = "" Then

Else
resp = MsgBox(Prompt:="Overwrite the existing file?", _
Buttons:=vbYesNo)
End If


If resp = vbYes Then
Application.DisplayAlerts = False
.SaveAs Filename:=myFileName, _
FileFormat:=xlWorkbookNormal
Application.DisplayAlerts = True
Else
MsgBox "File Not Saved!"
End If
End With

End Sub


Thanks Again
Alan
 
What line causes the error?

This subscript out of range usually means that you're trying to refer to
something that doesn't exist...

Like this line:

With Workbooks("book.xlt")

If book.xlt didn't exist (or wasn't open as an editable template), it would
cause errors.

Same kind of thing if the worksheet "costings" didn't exist with this line:

.Worksheets("costings")
 
Back
Top