Save As Query

[cosmarchy]

Hi,

Is it possible to save an excel file as another name without actually using the new file?

Traditionally when you save a file using Save As you then continue using the new file name.

What I want is to be able to save a file to another location but continue using the original file in it's original location.

Has anyone done this with VBA?

Thanks

[CodeNinja]

Easy to do... Just save as (Backup Name) then save as (Original Name)...

The attached code would do the trick, but would not overwrite the save as shortcuts... you could program in a shortcut by holding ALT and hitting F8 then highlighting "SaveBackup" macro then clicking options...

Also, if you try to save as an illegal extension (xlsx, etc) then it would break... so you can add your own error handling, or if you need me to I could...



[vba]Public Type BROWSEINFO

hOwner As Long

pidlRoot As Long

pszDisplayName As String

lpszTitle As String

ulFlags As Long

lpfn As Long

lParam As Long

iImage As Long

End Type

Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long





Function GetDirectory(Optional Msg) As String

Dim bInfo As BROWSEINFO

Dim path As String

Dim r As Long, X As Long, Y As Integer

' Root folder = Desktop

bInfo.pidlRoot = 0&

' Title in the dialog

If IsMissing(Msg) Then

bInfo.lpszTitle = "Select a folder."

Else

bInfo.lpszTitle = Msg

End If

' Type of directory to return

bInfo.ulFlags = &H1

' Display the dialog

X = SHBrowseForFolder(bInfo)

' Parse the result

path = Space$(512)

r = SHGetPathFromIDList(ByVal X, ByVal path)

If r > 0 Then

Y = InStr(path, Chr$(0))

GetDirectory = Left(path, Y - 1)

Else

GetDirectory = ""

End If

End Function

Sub saveBackup()
Dim sOriginalFile As String
Dim sBackupName As String
Dim sBackupPath As String
sOriginalFile = ThisWorkbook.path & "\" & ThisWorkbook.Name

sBackupPath = GetDirectory("Please find the folder you wish to save in") & "\"
sBackupName = InputBox("Please enter the name and extension you wish to save as")

ThisWorkbook.SaveAs Filename:=sBackupPath & sBackupName
ThisWorkbook.SaveAs Filename:=sOriginalFile

End Sub[/vba]

[snb]

Use

[VBA]
Sub M_snb()
thisworkbook.SaveCopyAs replace(thisworkbook.fullname,".xl","_001.xl"
End Sub
[/VBA]

[cosmarchy]

Many thanks for your help guys, this seems to have cleared this up

[CodeNinja]

lol snb, I come up with this really complicated version... and... and... and...

*sigh*

[snb]

@CN

sorry.....