Run-time error '-2147467259 (80004005)'

[TTUK]

Hello all & Happy New Year!

I am getting a run-time error as per the title of '-2147467259 (80004005)'
It says on the VB error an 'Automation error' and 'Unspecified error'.

About the script -
It is activated when a user selects a cell containing the words 'Raise Follow-up Report', which is a hyperlink which runs this code below of Followup_Confirm.
Now probably, this isn't the prettiest code so any help welcomed!

Sub Followup_Confirm()




    Dim Msg As String, Ans As Variant


               Msg = "Confirm you would like to raise a Follow-up form"


    Ans = MsgBox(Msg, vbYesNo)


    Select Case Ans


    Case vbYes
        Application.DisplayAlerts = False
        ' Copy date and paste in cell on row
        ActiveCell.FormulaR1C1 = "Form Raised"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = "=R4C54"


        Selection.Copy


        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False


        ' Select the worksheet that is to be saved
        Sheets("IIR_temp").Select
        
        
        ActiveSheet.Copy ' Copies active sheet to a new workbook
             
        Range("A2:BG16").Select
        Selection.Copy
        
        Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
         
        'Import CLS file to new workbook
        With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
             .DeleteLines StartLine:=1, Count:=.CountOfLines
            .AddFromFile "\\dataserver\ManagementSystem\NYL-HSE Group\Accidents, Near Misses & Hazard Alerts\IIRSaveUpdate.txt"
        End With
        
        'Import BAS file to new workbook
        Dim filename As String
        filename = "\\dataserver\ManagementSystem\NYL-HSE Group\Accidents, Near Misses & Hazard Alerts\IIR_Exchange.bas"
        Application.VBE.ActiveVBProject.VBComponents.Import (filename)


Application.DisplayAlerts = False


Application.CutCopyMode = False


[COLOR=#ff0000]ActiveWorkbook.SaveAs Range("A1").Value & ".xlsm", 52[/COLOR]
ActiveWorkbook.Close


Sheets("Register").Select
    
End Select
End Sub

It is debugging on the line - ActiveWorkbook.SaveAs Range("A1").Value & ".xlsm", 52
The script creates a new worksheet and paste's certain information into it.
Then saves (above) as the cell value of A1.

The cell A1 is referencing another workbook with the file path in - could this be the issue?

I appreciate any help to fix this!

Thank you

 

[RoryA]

Which workbook and sheet should the A1 belong to?

 

[TTUK]

Hi RoryA,

I have updated the script whereby A1 now contains the file path and filename.
A1 = \\dataserver\ManagementSystem\NYL-HSE Group\Accidents, Near Misses & Hazard Alerts\AIR-800\AIR-800_04.01.2018_OFA_Incident Investigation Report

Each report raised will have a different folder and file path name.


Thanks,

 

[RoryA]

I meant which sheet's A1 cell are you trying to read? And where is your code located (which module)?

 

[TTUK]

Hi RoryA,

Hope I am understanding you correctly -
The sheet is called IIR_temp where A1 is situated, and the value inside A1 is the file path and file name.

The module is called IIR_Confirm_Msg where Followup_Confirm() is held.

Hope this helps.

Thank you for the support.

 

[RoryA]

In that case the code itself looks OK. Are you sure that the path is correct, and does the code you are importing compile properly?

 

[TTUK]

Hi RoryA,

Well the codes are imported to the document correctly.
But each time they seem to fall over and fail.
I think it is the imported codes which are causing the issue.


The first is IIRSaveUpdate.txt
This runs everytime the document is saved and will change cell properties and runs the module Export_IIR

Attribute VB_Name = "ThisWorkbook"Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet
Set ws = ActiveSheet
With ws.Range("BJ2")
.Value = Now
.NumberFormat = "dd/mm/yyyy hh:mm"
End With
ws.Range("BK2") = Environ("username")


Call Export_IIR


End Sub

The IIRExchange.bas runs in the Export_IIR.
This copies the information from the worksheet to the AIR_Exchange.xlsx as per code below.

Attribute VB_Name = "IIR_Exchange"Sub Export_IIR()
Application.EnableEvents = False
Application.ScreenUpdating = False
    
Dim x As Workbook
Dim y As Workbook
Dim lastRow As String


Call LastAuthor
Call LastSavedTimeStamp


Application.DisplayAlerts = False


'## Open both workbooks first:
Set x = ActiveWorkbook
Set y = Workbooks.Open("\\dataserver\ManagementSystem\NYL-HSE Group\Accidents, Near Misses & Hazard Alerts\AIR_Exchange.xlsx")




'Now, copy what you want from x:
x.Sheets("IIR_temp").Range("BI2:BK2").Copy


'Paste last row
lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1




'Now, paste to y worksheet:
y.Sheets("AIR_Exchange").Range("A" & lastRow).PasteSpecial xlPasteValues
  With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With


Application.EnableEvents = False
Application.ScreenUpdating = False




'Close y:
y.Save
y.Close


Application.EnableEvents = True
End Sub


Function LastAuthor()
LastAuthor = ActiveWorkbook.BuiltinDocumentProperties("Last Author")
End Function


Function LastSavedTimeStamp() As Date
LastSavedTimeStamp = ActiveWorkbook.BuiltinDocumentProperties("Last Save Time")
End Function

Please if you see something glaringly obvious and wrong can you let me know as I know the code is messy, but its the way I've pulled it from sources to make it work.
As it did work in the past...

Many Thanks.

 

[RoryA]

Remove all of this:

Attribute VB_Name = "ThisWorkbook"Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True

from the first text file.

 

[TTUK]

Removed, however, still getting the error with the following line highlighted in yellow.

ActiveWorkbook.SaveAs Range("A1").Value & ".xlsm", 52


Thanks for helping!

 

[RoryA]

The only other thing I can suggest at the moment, is to try importing the second file first since the code added to ThisWorkbook depends on it.