Automation error / file crash

trevolly

Board Regular
Joined
Aug 22, 2021
Messages
120
Office Version
  1. 365
Platform
  1. Windows
Hi all

Ive designed a workbook that starts off called "Engine Run Form" thatgoes back and forth between departments at work. I've written some vba that at a point in the workbook saves and exports the workbook to an email and fills in recipients, the email title and attaches the workbook as an .xlsm file. It then also opens the Save As box, points the save location to a specific folder ("X:\Airfield Operations\2023 Airfield Inspection and Data\Aircraft High Powered Engine Runs\NEW\Pending Runs\") and names the workbook from the content of two cells on a worksheet "GVIIT - 23-07-2023" for example. It also selects the file extension as .xlsm. The Save As box then waits for the user to confirm the save. This all works perfectly.

At the end of the form is another button with vba attached to it to copy data from a worksheet within the workbook, open another workbook, paste the data, save the data workbook, close it and then open the Save As box to save the master workbook again as earlier but in to a different folder, "X:\Airfield Operations\2023 Airfield Inspection and Data\Aircraft High Powered Engine Runs\NEW\Completed Runs\"


Again all of this works, the file is named right in the Save AS box, the Save As box points to the right path, and it set to save as .xlsm, but after the user confirms the save as details and presses save, the save as box closes and I get either an "Automation error" or the workbook crashed and doesn't save.

Can anyone see what could be causing this to fail as the Save as part of the code works perfectly in the earlier step on the form?

I'd really really appreciate any help - this is the last step on the workbook project.


VBA Code:
Sub copy()

Application.ScreenUpdating = False
Dim wbBook1 As Workbook
Dim wbBook2 As Workbook

Set wbBook1 = ThisWorkbook
Set wbBook2 = Workbooks.Open("\\Gatwick.Airport.Local\HomeDirs$\HDR2-02\Trevor\Profile\Desktop\New folder (2)\master log.xlsx")

Set copySheet = wbBook1.Worksheets("CopyData")
Set pasteSheet = wbBook2.Worksheets("Data")

Application.ScreenUpdating = False

  copySheet.Range("A3:AF3").copy
  pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlValues
  Application.CutCopyMode = False
  
   Cells.Select
    With Selection
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range("A3").Select

ActiveWorkbook.Save
MsgBox ("Data transferred and saved.  Thank you")
ActiveWorkbook.Close

'ThisWorkbook.Save 'save current workbook in current name
Dim strFolder As String
    Dim i As Long
    Dim fname As String
    Dim reqdate As String

    'Find the position of the period in the file name
    i = InStr(ActiveWorkbook.Name, ".")
    fname = Range("C2")
    reqdate = Range("C6").Text
    

    'Create a default file name by concatenating the file name without the extention _
        plus the current date and time, and plus the xlsm extention
    Filename = Left(fname, i - 1) & " - " & (reqdate) & ".xlsm"

    'Open Save As dialog to a default folder with default file name
    With Application.FileDialog(msoFileDialogSaveAs)
        .AllowMultiSelect = False
        .FilterIndex = 2  '2 = xlsm
        .InitialFileName = "X:\Airfield Operations\2023 Airfield Inspection and Data\Aircraft High Powered Engine Runs\NEW\Completed Runs\" & Filename
        .InitialView = msoFileDialogViewDetails
        If .Show = -1 Then strFolder = .SelectedItems(1) Else Exit Sub
        .Execute
    End With
End Sub
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
I have made a couple of edits to your code where I saw something that may cause an Error. Mostly variable definitions. Be explicit and try not to use ActiveWorkbook if working with more than one open Workbook.
VBA Code:
Sub copy()

Application.ScreenUpdating = False
Dim wbBook1 As Workbook
Dim wbBook2 As Workbook

Set wbBook1 = ThisWorkbook
Set wbBook2 = Workbooks.Open("\\Gatwick.Airport.Local\HomeDirs$\HDR2-02\Trevor\Profile\Desktop\New folder (2)\master log.xlsx")

Set copySheet = wbBook1.Worksheets("CopyData")
Set pasteSheet = wbBook2.Worksheets("Data")

Application.ScreenUpdating = False

  copySheet.Range("A3:AF3").copy
  pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlValues
  Application.CutCopyMode = False
 
   Cells.Select                  '<------- Completely define your Range. i.e. - pasteSheet.Cells.Select
    With Selection
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range("A3").Select

ActiveWorkbook.Save     '<--------- Exactly define which Workbook to save. i.e. - wbBook1.Save or wbBook2.Save (you've already defined the variables)
MsgBox ("Data transferred and saved.  Thank you")
ActiveWorkbook.Close    '<--------- Exactly define which Workbook to save. i.e. - wbBook1.Save or wbBook2.Save (you've already defined the variables)

'ThisWorkbook.Save 'save current workbook in current name
Dim strFolder As String
    Dim i As Long
    Dim fname As String
    Dim reqdate As String

    'Find the position of the period in the file name
    i = InStr(ActiveWorkbook.Name, ".")                        '<-------- Exactly define the Workbook. i.e. - i = InStr(wbBook1.Name, ".")
    fname = Range("C2")
    reqdate = Range("C6").Text
   

    'Create a default file name by concatenating the file name without the extention _
        plus the current date and time, and plus the xlsm extention
    Filename = Left(fname, i - 1) & " - " & (reqdate) & ".xlsm"

    'Open Save As dialog to a default folder with default file name
    With Application.FileDialog(msoFileDialogSaveAs)
        .AllowMultiSelect = False
        .FilterIndex = 2  '2 = xlsm
        .InitialFileName = "X:\Airfield Operations\2023 Airfield Inspection and Data\Aircraft High Powered Engine Runs\NEW\Completed Runs\" & Filename
        .InitialView = msoFileDialogViewDetails
        If .Show = -1 Then strFolder = .SelectedItems(1) Else Exit Sub
        .Execute
    End With
End Sub
 
Upvote 0
Thanks for helping @Skyybot - I've had a look at what you suggested but I still get the same issue, the workbook just crashes. Annoying as I just want to run the copy to another workbook (which it does) and then have a Save as box open and fill the filename with the workbooks existing name and .xsml (macro enabled and then point to a specific path. I dont need it to auto save. Its the last part of the workbook project!!
 
Upvote 0
I have made a couple of edits to your code where I saw something that may cause an Error. Mostly variable definitions. Be explicit and try not to use ActiveWorkbook if working with more than one open Workbook.
VBA Code:
Sub copy()

Application.ScreenUpdating = False
Dim wbBook1 As Workbook
Dim wbBook2 As Workbook

Set wbBook1 = ThisWorkbook
Set wbBook2 = Workbooks.Open("\\Gatwick.Airport.Local\HomeDirs$\HDR2-02\Trevor\Profile\Desktop\New folder (2)\master log.xlsx")

Set copySheet = wbBook1.Worksheets("CopyData")
Set pasteSheet = wbBook2.Worksheets("Data")

Application.ScreenUpdating = False

  copySheet.Range("A3:AF3").copy
  pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlValues
  Application.CutCopyMode = False
 
   Cells.Select                  '<------- Completely define your Range. i.e. - pasteSheet.Cells.Select
    With Selection
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range("A3").Select

ActiveWorkbook.Save     '<--------- Exactly define which Workbook to save. i.e. - wbBook1.Save or wbBook2.Save (you've already defined the variables)
MsgBox ("Data transferred and saved.  Thank you")
ActiveWorkbook.Close    '<--------- Exactly define which Workbook to save. i.e. - wbBook1.Save or wbBook2.Save (you've already defined the variables)

'ThisWorkbook.Save 'save current workbook in current name
Dim strFolder As String
    Dim i As Long
    Dim fname As String
    Dim reqdate As String

    'Find the position of the period in the file name
    i = InStr(ActiveWorkbook.Name, ".")                        '<-------- Exactly define the Workbook. i.e. - i = InStr(wbBook1.Name, ".")
    fname = Range("C2")
    reqdate = Range("C6").Text
  

    'Create a default file name by concatenating the file name without the extention _
        plus the current date and time, and plus the xlsm extention
    Filename = Left(fname, i - 1) & " - " & (reqdate) & ".xlsm"

    'Open Save As dialog to a default folder with default file name
    With Application.FileDialog(msoFileDialogSaveAs)
        .AllowMultiSelect = False
        .FilterIndex = 2  '2 = xlsm
        .InitialFileName = "X:\Airfield Operations\2023 Airfield Inspection and Data\Aircraft High Powered Engine Runs\NEW\Completed Runs\" & Filename
        .InitialView = msoFileDialogViewDetails
        If .Show = -1 Then strFolder = .SelectedItems(1) Else Exit Sub
        .Execute
    End With
End Sub

The vba works earlier in the workbook - opening a Save as box - naming the file and .xsml extension and points to the specific folder. It names the workbook from "Master form" to what the vba asks (cells C2 and C6, creating "GEZAW - 31.07.2023" for example) Do you think its to do with the workbook already being called "GEZAW - 31.07.2023" by the time the later vba runs and its trying to name the workbook the same as it is??
 
Upvote 0
Maybe. If the Open Workbook has the same name as the Workbook you're trying to save maybe use .Save instead of .SaveAs
 
Upvote 0

Forum statistics

Threads
1,215,076
Messages
6,122,983
Members
449,092
Latest member
Mr Hughes

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