View Full Version : Save As Query
cosmarchy
03-05-2013, 02:39 AM
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
03-05-2013, 09:26 AM
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...
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
Use
Sub M_snb()
thisworkbook.SaveCopyAs replace(thisworkbook.fullname,".xl","_001.xl"
End Sub
cosmarchy
03-05-2013, 10:55 AM
Many thanks for your help guys, this seems to have cleared this up :yes
CodeNinja
03-05-2013, 11:44 AM
lol snb, I come up with this really complicated version... and... and... and...
*sigh*
:bow:
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.