WHY is this SaveAs code not working?

[Mister H]

Hi All:

I was playing around with a code that simply is saving a copy of the file with a specific name. It appears to work but the file is not saved (No Errors and it seems that it is saving but it doesn't?). What have I missed in regards to the coding?

I want the user to be able to select their own Path but the filename needs to be specific.

Here is the code:

Sub SaveFile()
'Automatic (DEFAULT) Naming of Spreadsheet
Dim TempFileName As String

TempFileName = FilePath & ActiveSheet.Range("C3") & "-" & ActiveSheet.Range("L3")
NewName = Application.GetSaveAsFilename(InitialFileName:=TempFileName, _
        fileFilter:="Excel Files (*.xls), *.xls")
 
If NewName = False Then Exit Sub
Application.ScreenUpdating = True
Range("A1").Select
End Sub

THANKS to anyone that can assist,
Take Care,
Mark

 

[Jonmo1]

There's no command in there to save the file.

NewName = Application.GetSaveAsFilename DOES NOT SAVE THE FILE!!!!

that line only allows the user to pick a directory and filename. It then assigns that path and filename to the variable NewName.

You must then write a SaveAs Line using that variable...

ActiveWorkbook.SaveAs Filename:=NewName

 

[Mister H]

THANKS jonmo1. I knew I must have forgotten something. I had pretty much figured that when the user clicked the Save Button that, that would Save the file. THANKS for the filling me in.

What is the line(s) of code that I would add to prevent an error if the file already exists and the user does not want to replace the existing file? Is it just something like:

On Error Resume Next

THANKS Again for the refresher

Have a GREAT night,
Mark

 

[Mister H]

Hi All:

I was wondering if someone could tell me if the line I have added in is correct? When the person Save the file I want the message to pop up if the file already exist but if they choose not to replace the existing file I don't want the user to get a Run-Time Error. I added "On Error Resume Next" which I hope is correct but I am not certain if it will mess up anything else. Here is the code:

Sub SaveFile()
'Automatic (DEFAULT) Naming of Spreadsheet
TempFileName = FilePath & ActiveSheet.Range("C3") & "-" & ActiveSheet.Range("L3")
NewName = Application.GetSaveAsFilename(InitialFileName:=TempFileName, _
        fileFilter:="Excel Files (*.xls), *.xls")
 
If NewName = False Then Exit Sub
 
[COLOR=red]On Error Resume Next[/COLOR]
 
ActiveWorkbook.SaveAs Filename:=NewName
Application.ScreenUpdating = True
Range("A1").Select
End Sub

THANKS to anyone that can assist...

Take Care,
Mark

 

[nirvana_]

re-arrange your code like this and try it.

Application.ScreenUpdating = True
[COLOR=black]On Error Resume Next[/COLOR]
ActiveWorkbook.SaveAs Filename:=NewName
Range("A1").Select
End Sub

 

[Mister H]

Now my problem is sending the Workbook via automatic email.

Hi nirvana:

THANKS for your reply. Your assistance is VERY MUCH appreciated

I am now running into another problem (go figure...) in regards to automatically emailing my spreadsheet. I am getting an error regarding

"A document with the same name is already open. You can not open two documents with the same name"

Basically when they click the Email button I want it to:

1) Check that the Variance is 0
2) Allow the user to save their file with a specific name
3) Email the Workbook
4) Return to the document they just saved

Here are the codes I am using. Not sure how to fix the problem. Any Ideas? ANYONE

THANKS

Private Sub EmailButton_Click()
'First checks to see if Variance is 0 (Zero), IF NOT then DO NOT EMAIL
If Sheets("Bank Deposit Worksheet").Range("F74").Value <> 0 Then
MsgBox "The variance on this worksheet does not equal zero (0)." & vbCr & vbCr & "Please verify your figures and make the necessary corrections." & vbCr & vbCr & "Once the variance equals zero (0) you may submit your worksheet for processing.", vbOKOnly, "PLEASE Note!"
 
 
Range("F71").Select
Application.ScreenUpdating = True
Exit Sub
 
Else
 
Application.Run _
        "SaveFile"
 
Application.Run _
        "EmailOS"
 
End If
 
End Sub

Sub SaveFile()
'Automatic (DEFAULT) Naming of Spreadsheet
TempFileName = FilePath & ActiveSheet.Range("C3") & "-" & ActiveSheet.Range("L3")
NewName = Application.GetSaveAsFilename(InitialFileName:=TempFileName, _
        fileFilter:="Excel Files (*.xls), *.xls")
 
If NewName = False Then Exit Sub
Application.ScreenUpdating = True
On Error Resume Next
ActiveWorkbook.SaveAs Filename:=NewName
Range("A1").Select
 
End Sub

Sub EmailOS()
'Sends an Email with the ENTIRE Workbook attached.
'Working in 2000-2007
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim i As Long, ToStr As String
    Set wb1 = ActiveWorkbook
    With Sheets("Bank Deposit Worksheet")
        For i = 4 To 8
            With .Range("M" & i)
                If .Value <> "" Then ToStr = ToStr & .Value & ";"
            End With
        Next i
    End With
    ToStr = Left(ToStr, Len(ToStr) - 1)
    If Val(Application.Version) >= 12 Then
        If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
            MsgBox "There is VBA code in this xlsx file, there will" & vbNewLine & _
                   "be no VBA code in the file you send. Save the" & vbNewLine & _
                   "file first as xlsm and then try the macro again.", vbInformation
            Exit Sub
        End If
    End If
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
    'Make a copy of the file/Open it/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = FilePath & ActiveSheet.Range("C3") & "-" & ActiveSheet.Range("L3")
    FileExtStr = "." & LCase(Right(wb1.Name, _
                                   Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
 
 
 
    'Below is the line where the error occurs...
    Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)
 
 
 
 
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .To = ToStr
        .CC = ""
        .BCC = ""
        .Subject = TempFileName
        .Body = "Attached is our Bank Deposit Worksheet for your review and processing."
        .Attachments.Add wb2.FullName
        .Display
    End With
    On Error GoTo 0
    wb2.Close SaveChanges:=False
 
    'Delete the file
    Kill TempFilePath & TempFileName & FileExtStr
    Set OutMail = Nothing
    Set OutApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
 
End Sub

 

[Mister H]

Never mind

I spoke with the user and have decided that the 2 files can be saved with different names so I removed the - from one of them. The critical naming was for the file being sent by email.

Have a GREAT weekend ALL,
THANKS to the Board for ALL your help over the years,
Mark

 

[nirvana_]

Just 3 things were need to get it to work in EmailOS sub procedure.

1) Comment out the line given below.

'Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

2) Change the .attachment.add line to

                .Attachment.Add = TempFilePath & TempFileName & FileExtStr

3) Change wb2.Close to wb1.Close. Given below.

wb1.Close SaveChanges:=False

 

[Mister H]

THANKS nirvana... I will give that a go.

Have an EXCELLENT weekend,
Mark