Have File saved from name found in specific cell

Papi

Well-known Member
Joined
May 22, 2007
Messages
1,592
I found this code on another site and it works fine as it is. What is needed to have it look at in worksheet Inventory in cell B42 rather than having to enter the name?

Code:
Option Explicit
 
Sub KillPreviousFile()
    Dim szMsgResponse As String
     
     '   Get the name of this workbook with out the .xlsm
    Dim szDefaultName As String
    szDefaultName = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
     
     
StartAgain:
     '   Use an input box to obtain the new file name:
    Dim szNewBookName As String
    szNewBookName = InputBox("Please enter a name for the new file" & _
    vbNewLine & _
    "It will be saved in the same directory as the original" & vbNewLine & _
    vbNewLine & _
    "Valid file-names cannot include these characters" & vbNewLine & _
    "< > \ / * ? | : ; """, , szDefaultName)
     
     
     '   If a name has been specified:
    If szNewBookName <> Empty Then
         
         
         '       Suppress messages
        Application.DisplayAlerts = False
         
         
         '       Determine old workbooks path and name and store for later use
        Dim szOldBook As String
        szOldBook = ThisWorkbook.FullName
         
         
         '       Create a valid path for our new file, same directory as this file
        Dim szThisPath As String
        szThisPath = ThisWorkbook.Path & "\"
         
         
         '       Build our new file name
        Dim szNewFileName As String
        szNewFileName = szThisPath & szNewBookName & ".xlsm"
         
         
         '       If the user typed in the same name as the original, we have some options
         '       we can present, by either starting the procedure over, saving the file,
         '       or canceling the procedure entirely
        If szNewFileName = szOldBook Then
             
             
             '           Variable szMsgResponse holde the msgbox button press:
            szMsgResponse = MsgBox("The new file name is the same as the original" & _
            vbNewLine & "Would you like to save now, try again, or cancel?", 19)
             
             '           Proceed based on the selected option
            Select Case szMsgResponse
            Case 2
                Exit Sub
            Case 7
                GoTo StartAgain
            Case 6
                ThisWorkbook.Save
                Exit Sub
            End Select
             
             
        End If
         
         
         '       If we are valid, save this file under the new name:
        On Error GoTo ExitProc
        ThisWorkbook.SaveAs szNewFileName, xlWorkbookNormal
         
         
         '       Then remove the old workbook we just were using
        Kill szOldBook
         
         
    Else
         
         
         '       if nothing was given in the input box, just exit.
        Exit Sub
         
    End If
     
ExitProc:
    Application.DisplayAlerts = True
    Exit Sub
     
InvalidName:
    MsgBox Err.Description
    GoTo ExitProc
End Sub
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Maybe replace this
Code:
Dim szNewBookName As String
    szNewBookName = InputBox("Please enter a name for the new file" & _
    vbNewLine & _
    "It will be saved in the same directory as the original" & vbNewLine & _
    vbNewLine & _
    "Valid file-names cannot include these characters" & vbNewLine & _
    "< > \ / * ? | : ; """, , szDefaultName)



with
Code:
Dim szNewBookName As String
szNewBookName = Sheets("Inventory").Range("B42").Value
 
Upvote 0
I ran the macro quite a few times and the file names appeared in order but had no need to open them until late last night. I am getting an error that reads "Excel cannot open file P1002 - Paid.xlsm' because the file format or file extension is not valid. Verify that the file has not been corrupted and that the file extension matches the format of the file.

The code I found used an older version of Excel with a file extension of .xls and I simply changed it to .xlsm. Might that be the issue?
 
Upvote 0
Another note is the files normally save about 70k and they are now saving about 170k.
 
Last edited:
Upvote 0
What version are you trying to open the file in ??
What is the value in B42 ??
 
Upvote 0
The files are created in Excel 2010 using a .xltm file which by default is turned into a .xlsm file format.
The formula grabs a variety of selections into cell B42 that looks like the following;
Code:
=TRIM(CLEAN(IF(B42<>"Paid",CONCATENATE("D",Main),TRIM(CLEAN(CONCATENATE("D",Main," - ",B42))))))

I added trim and clean because I found a foot marker in the start of the cell once it extracted the file name but it is only visible if the cursor is either in the cell or hovering over it. That did not help as it still shows the error. so a file would look like this 'D1032 - Paid.xlsm
 
Upvote 0
So the the original being a template file, I'd suggest that you try doing a saveas, rather than simply changing the extension, using the value in B42 first.
I don't think you can simply change the extension of a template to xlsm to get the desired result
 
Upvote 0
When the templates are opened they automatically change all formats to .xlsm. This is done in File/Options/Save/Save file in this format Excel macro enabled workbook (*xlsm)
I usually use VBA Code like this to save files in the same format so that they are defined.
Code:
    ActiveWorkbook.SaveAs Filename:="C:\Users\Alan\Documents\Delivery.xlsm", FileFormat:=52

The only thing that changed is trying to use the code from the original message to save the file and delete the old version. There are as many as three locations the files are saved i.e. back up.xlsm or D9999.xlsm for say a deliver ticket etc. Those files are fine. It is when I found the code to save and delete that I started having issues. Unfortunately I am not sure how most of that code works. It is hard to change what one is not in the know.
 
Upvote 0
Try saving the file as an xls extension....see if that works
change this


Code:
   szNewFileName = szThisPath & szNewBookName & ".xlsm"


to this

Code:
 szNewFileName = szThisPath & szNewBookName & ".xls"
 
Upvote 0

Forum statistics

Threads
1,213,535
Messages
6,114,192
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top