Automatic Save As and Close not working - please help!

[IPD]

Hi,

I can't get a seemingly simple piece of code to work:

I want to automatically 'save as' and close a document; however, the 'save as' dialogue box always comes up so that I have to click 'yes' before it will save the document. I would like this to be fully automatic so that when I run my macro I won't ever see the dialogue box (i.e. saves and closes automatically).

I've tried all of the existing suggestions for this type of problem but to no avail!

My code is given at the bottom of this post. The 'save' section is right at the end.

Thanks in advance for your help!

Option Explicit

'
' Set variable to correct factory location
'

Const strSaveLocation = "S:\Manufacturing\Motor Audit\Huangdao\Cheetah MB23G491 Gipsy Major\Rotor Dimensional Audit\"




Sub CMMDataInput()
'
' CMMDataInput
'
' Copies data from the Excel spreadsheet generated by the CMM software and pastes
' it in to the audit table (sheet: 'Template')
'
' Written 02/04/2014 by Paul Duncan
'
' Keyboard Shortcut: Ctrl+i

Dim FileN As String
Dim directoryfiles()
Dim file_open As String
Dim sheet_open As String
Dim directory As String
Dim working As String
Dim i As Long
Dim j As Long
Dim count As Integer
Dim stringInput As String
Dim strConstructFilename As String
Dim strFilenameAndPath As String
Dim strPath As String
Dim bPathFound As Boolean


' ************************* DEFINE THESE!! *****************
'directory = "C:\CMM Raw Data\"
'working = ".TEMPLATE_Automated Rotor Audit - v1 - Gipsy Major - Huangdao.xls"
' **********************************************************



For j = 0 To 35
        
        ' Arrange Radius x36 in 1st column (within the CMM excel spreadsheet)
        Cells(156 + j * 4, 8).Select
        Selection.Copy
        Cells(1 + j, 1).Select
        ActiveSheet.Paste
        
        ' Arrange Rim Height x36 in 2nd column
        Cells(12 + j * 4, 8).Select
        Selection.Copy
        Cells(1 + j, 2).Select
        ActiveSheet.Paste
    
Next
         
    ' Copy from CMM spreadsheet and paste in to the audit sheet
    Range("A1:B36").Select
    Selection.Copy
    Workbooks.Open Filename:= _
        "I:\Documents\Projects\Cheetah\Rotor\CMM\.TEMPLATE_Automated Rotor Audit - v1 - Gipsy Major - Huangdao.xls"
    Sheets("Template").Select
    'Windows(working).Activate
    'Sheets("Template").Select
    Range("C27").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
        'ActiveWindow.Close savechanges:=False
    'Range("C10") = Application.InputBox(Prompt:= _
                '"Please enter the date when the part was moulded (dd/mm/yyyy)", _
                    'Title:="MOULDED DATE", Type:=2)
    'Range("C11") = Application.InputBox(Prompt:= _
                '"Please enter the core number.", _
                    'Title:="CORE NUMBER", Type:=1)
    'Range("C12") = Application.InputBox(Prompt:= _
    '            "Please enter the 'top' tool number (1 or 2)", _
    '                Title:="TOP TOOL NUMBER", Type:=1)
    'Range("C13") = Application.InputBox(Prompt:= _
    '            "Please enter the 'bottom' tool number (1 or 2).", _
    '                Title:="BOTTOM TOOL NUMBER", Type:=1)
    'Range("C14") = Application.InputBox(Prompt:= _
    '            "Please enter the serial number of the part", _
    '                Title:="SERIAL NUMBER", Type:=2)
    'Range("C15") = Application.InputBox(Prompt:= _
    '            "Please specify the shift (day/night).", _
    '                Title:="SHIFT", Type:=2)
    'Range("C16") = Application.InputBox(Prompt:= _
    '            "Please enter the operator's initials", _
    '                Title:="OPERATOR", Type:=2)
    'Range("C17") = Application.InputBox(Prompt:= _
    '            "Please specify any special conditions.", _
    '                Title:="SPECIAL CONDITIONS", Type:=2)


On Error GoTo ErrorTrap

    Workbooks(".TEMPLATE_Automated Rotor Audit - v1 - Gipsy Major - Huangdao.xls").Activate

    'If MsgBox("Are you sure you want to save the current audit data to disk?",
            'vbYesNo, "Save Audit") = vbNo Then Exit Sub


' Create combined filename and path
strConstructFilename = "Rotor Audit " & Format(ActiveSheet.Range("MoldDate").Value, "yyyy-mmm-dd") & " - " & ActiveSheet.Range("FactorySite").Value & " " & " - S" & ActiveSheet.Range("Shift").Value & " " & " - 3T" & ActiveSheet.Range("C12").Value & "/" & "3B" & ActiveSheet.Range("C13").Value & " - " & ActiveSheet.Range("Serial_Number").Value
strPath = "S:\Manufacturing\Motor Audit\Huangdao\Cheetah MB23G491 Gipsy Major\Rotor Dimensional Audit\"
strFilenameAndPath = strPath & strConstructFilename
    
    stringInput = Application.GetSaveAsFilename(strFilenameAndPath, "Excel Spreadsheets (*.xls), *.xls")
        
    If stringInput <> "False" Then
        ActiveWorkbook.SaveAs Filename:=stringInput, ReadOnlyRecommended:=True, addtomru:=True
    End If

    ActiveWorkbook.Close
      
ErrorTrap:
    MsgBox "Error occurred while saving workbook!", vbCritical, "Save Audit"
    
End Sub

[mc84excel]

Before SaveAs add this line

application.DisplayAlerts = False

Add it again afterwards and reset it to True. HTH

[IPD]

Hi HTH,

Thank you very much for your suggestion.

However, it didn't close the dialogue box; I'm puzzled as to why!

I entered your suggestion as follows:

    If stringInput <> "False" Then
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=stringInput, ReadOnlyRecommended:=True, addtomru:=True
        Application.DisplayAlerts = True
    End If

[mc84excel]

However, it didn't close the dialogue box; I'm puzzled as to why!

Because stringInput is using Application.GetSaveAsFilename? You shouldn't need to.

Try changing your code to match the below

strFilenameAndPath = strPath & strConstructFilename

    'next line = not required. you already have the fullname and you don't want the saveas dialog to appear
    'stringInput = Application.GetSaveAsFilename(strFilenameAndPath, "Excel Spreadsheets (*.xls), *.xls")

    'If stringInput <> "False" Then
        Application.DisplayAlerts = False
        With ActiveWorkbook
            .SaveAs Filename:=strFilenameAndPath, ReadOnlyRecommended:=True, addtomru:=True
            .Close
        End With
        Application.DisplayAlerts = True
    'End If

ErrorTrap:
    MsgBox "Error occurred while saving workbook!", vbCritical, "Save Audit"
End Sub

P.S. HTH is an abbreviation of Hope That Helps.

[IPD]

Thank you very much mc84excel!!!

It worked like a charm.

I understand a little more about VBA now so thanks.

Right,thanks for letting me know about HTH, as you can see I'm quite a rookie in forums!



A+++ help rating

[mc84excel]

Thank you very much mc84excel!!!

It worked like a charm.

I understand a little more about VBA now so thanks.

Right,thanks for letting me know about HTH, as you can see I'm quite a rookie in forums!



A+++ help rating

Glad to help.


If your thread is solved, please use 'Thread Tools' (dropdowns at the top of your thread) to mark it SOLVED as a courtesy to other forum users.

If my posts helped solve your thread, please consider taking a few seconds to click '* Add Reputation' on the post that helped. Thank you.