Results 1 to 5 of 5

Thread: Run-time error '1004': Method 'Activate' of object '_Workbook' failed only on new PC
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    Board Regular
    Join Date
    Jul 2016
    Posts
    115
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Run-time error '1004': Method 'Activate' of object '_Workbook' failed only on new PC

    Hi Folks,

    I have an old excel model last modified in 2010 that was written by a pretty decent VBA / SQL programmer who has since deceased.

    All our old machines are running Windows 7 professional on a 64 bit OS using 32 bit Excel 2013 (8 gb RAM).
    A new PC installed recently runs Windows 7 professional on a 64 bit OS using 32 bit Excel 2013 (16 gb RAM).

    When this old excel model attempts to import data from a *.xlsx file on the new PC, the following error message is generated: Run-time error '1004': Method 'Activate' of object '_Workbook'. The model has no issues importing data from a *xls file (97-2003).


    Here is the Module of Code (line that fails is larger font in Red)

    Code:
    Option Explicit
    Option Private Module
    
    
    Public Function GetImportWorkbookPath() As Variant
    
    
    '// Get File Path Using A Pre-Built Dialog
        GetImportWorkbookPath = Application.GetOpenFilename(FileFilter:="Excel Files,*.xls*", Title:="Please Select Import File", MultiSelect:=True)
    End Function
    
    
    Public Function ValidateImportFilePath(FilePath As String) As Boolean
    
    
    '// Assume Valid Until Proved Otherwise
        ValidateImportFilePath = True
    
    
    '// Validate
        If LCase(FilePath) = "false" Or IsEmpty(FilePath) Then
            ValidateImportFilePath = False
        End If
        
    End Function
    
    
    Public Sub ObtainImportData(importFile As Workbook)
    Dim impData As Variant
    Dim impSheet As Worksheet
    
    
    '// Obtain Data From Import File
        importFile.Activate
        Set impSheet = importFile.Sheets(1)
        impSheet.Activate
        If ImportHasExtraRows = True Then
            impSheet.Range("5:6").EntireRow.Delete
            impSheet.Range("1:3").EntireRow.Delete
        End If
        FindLastRow impSheet
        FindLastColumn impSheet
        impData = impSheet.Range(Cells(1, 1), Cells(LastRow, LastCol))
    
    
    '// Deposit Data Into 'ImportSheet'
        EventCalc.Activate
        With shtImportData
            .visible = xlSheetVisible
            .Activate
            .Range(Cells(1, 1), Cells(LastRow, LastCol)).value = impData
        End With
        
    '// Close ImportFile?
        importFile.Close False
    
    
    End Sub
    
    
    Public Sub ObtainImportDataMultipleWB(importFile As Workbook, FirstWB As Boolean)
    Dim ImportData As Variant
    Dim AllocData As Variant
    Dim ImportSheet As Worksheet
    Dim currentStoreList As Variant
    Dim errmsg As String
    Dim x As Long, y As Long
    
    
    '// Obtain Data From Import File
        importFile.Activate
        Set ImportSheet = importFile.Sheets(1)
        ImportSheet.Activate
        If ImportHasExtraRows = True Then
            ImportSheet.Range("5:6").EntireRow.Delete
            ImportSheet.Range("1:3").EntireRow.Delete
        End If
        FindLastRow ImportSheet
        FindLastColumn ImportSheet
        ImportData = ImportSheet.Range(Cells(1, 1), Cells(LastRow, LastCol))
        
    '// Determine If Is First Import - If so deposit data, if not perform checks and append data!
        If FirstWB = True Then
        
            '// Deposit Data
            EventCalc.Activate
            With shtImportData
                .visible = xlSheetVisible
                .Activate
                .Range(Cells(1, 1), Cells(LastRow, LastCol)).value = ImportData
            End With
                
        Else
        
            '// Obtain List of Stores To Check Against
            EventCalc.Activate
            FindLastRow shtImportData
            currentStoreList = shtImportData.Range(Cells(1, 1), Cells(LastRow, 1))
        
            '// Perform Check - On Mismatch Exit.
            If UBound(currentStoreList, 1) <> UBound(ImportData, 1) Then
                errmsg = "Count of Stores in " & importFile.Name & vbCrLf & "Doesn't Equal Count of Stores In Previous Imported Files - Please Check!"
                CriticalErrorFailure errmsg
                RestoreTemplate
                End
            End If
            
            For x = ImportData_StartAllocationRow To UBound(currentStoreList, 1)
            
                If currentStoreList(x, 1) <> ImportData(x, 1) Then
                    errmsg = "Store: " & currentStoreList(x, 1) & " <> " & ImportData(x, 1) & vbCrLf & "Whilst Attempting To Import: " & importFile.Name
                    CriticalErrorFailure errmsg
                    RestoreTemplate
                    End
                End If
            
            Next x
            
            '// If Stores Match Entirely Copy Only Allocation Data Across (Store Data Not Required)
            FindLastRow shtImportData
            FindLastColumn shtImportData
            
            ReDim AllocData(1 To UBound(ImportData, 1), 1 To UBound(ImportData, 2) - (ImportData_StartProductsColumn - 1))
            
            For x = 1 To UBound(ImportData, 1)
            
                For y = ImportData_StartProductsColumn To UBound(ImportData, 2)
            
                    AllocData(x, (y - ImportData_StartProductsColumn) + 1) = ImportData(x, y)
                    
                Next y
                
            Next x
            
            shtImportData.Range(Cells(1, LastCol + 1), Cells(LastRow, (LastCol) + UBound(AllocData, 2))) = AllocData
            
            
        End If
    
    
    '// Remove Any Spare 'Empty' Columns...
        FindLastColumn shtImportData
        For x = LastCol To 1 Step -1
        
            shtImportData.Activate
            If Application.WorksheetFunction.CountA(Cells(1, x).Address & ":" & Cells(MaxRowsExcel2003, x).Address) = 0 Then
                shtImportData.Columns(x).Delete
            End If
        
        Next x
    
    
    
    
    '// Close Import File
        importFile.Close False
    
    
    End Sub
    Would anybody be willing to help me find out why this happens?

    For instance,
    1) Within this code, is there any VBA that is obsolete.
    2) Why would an extra 8 gb of RAM effect an import (seems that the main spec difference is the RAM).

    Has anybody had a similar thing happen to them??

    Kind regards,

    Doug.

  2. #2
    Board Regular steve the fish's Avatar
    Join Date
    Oct 2009
    Location
    Midlands, UK
    Posts
    7,650
    Post Thanks / Like
    Mentioned
    19 Post(s)
    Tagged
    3 Thread(s)

    Default Re: Run-time error '1004': Method 'Activate' of object '_Workbook' failed only on new PC

    I cant see where you are using that function in any of that code nor can i see an activate in that line. Are you sure its that line?

  3. #3
    Board Regular
    Join Date
    Jul 2016
    Posts
    115
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Run-time error '1004': Method 'Activate' of object '_Workbook' failed only on new PC

    Quote Originally Posted by steve the fish View Post
    I cant see where you are using that function in any of that code nor can i see an activate in that line. Are you sure its that line?
    Hi Steve the fish,

    I ran the model again this morning to double check and found that the line was further down the same page of code:
    Here is the culprit macro
    Code:
    Public Sub ObtainImportDataMultipleWB(importFile As Workbook, FirstWB As Boolean)
    Dim ImportData As Variant
    Dim AllocData As Variant
    Dim ImportSheet As Worksheet
    Dim currentStoreList As Variant
    Dim errmsg As String
    Dim x As Long, y As Long
    
    
    '// Obtain Data From Import File
       importFile.Activate
        Set ImportSheet = importFile.Sheets(1)
        ImportSheet.Activate
        If ImportHasExtraRows = True Then
            ImportSheet.Range("5:6").EntireRow.Delete
            ImportSheet.Range("1:3").EntireRow.Delete
        End If
        FindLastRow ImportSheet
        FindLastColumn ImportSheet
        ImportData = ImportSheet.Range(Cells(1, 1), Cells(LastRow, LastCol))
        
    '// Determine If Is First Import - If so deposit data, if not perform checks and append data!
        If FirstWB = True Then
        
            '// Deposit Data
            EventCalc.Activate
            With shtImportData
                .visible = xlSheetVisible
                .Activate
                .Range(Cells(1, 1), Cells(LastRow, LastCol)).value = ImportData
            End With
                
        Else
        
            '// Obtain List of Stores To Check Against
            EventCalc.Activate
            FindLastRow shtImportData
            currentStoreList = shtImportData.Range(Cells(1, 1), Cells(LastRow, 1))
        
            '// Perform Check - On Mismatch Exit.
            If UBound(currentStoreList, 1) <> UBound(ImportData, 1) Then
                errmsg = "Count of Stores in " & importFile.Name & vbCrLf & "Doesn't Equal Count of Stores In Previous Imported Files - Please Check!"
                CriticalErrorFailure errmsg
                RestoreTemplate
                End
            End If
            
            For x = ImportData_StartAllocationRow To UBound(currentStoreList, 1)
            
                If currentStoreList(x, 1) <> ImportData(x, 1) Then
                    errmsg = "Store: " & currentStoreList(x, 1) & " <> " & ImportData(x, 1) & vbCrLf & "Whilst Attempting To Import: " & importFile.Name
                    CriticalErrorFailure errmsg
                    RestoreTemplate
                    End
                End If
            
            Next x
            
            '// If Stores Match Entirely Copy Only Allocation Data Across (Store Data Not Required)
            FindLastRow shtImportData
            FindLastColumn shtImportData
            
            ReDim AllocData(1 To UBound(ImportData, 1), 1 To UBound(ImportData, 2) - (ImportData_StartProductsColumn - 1))
            
            For x = 1 To UBound(ImportData, 1)
            
                For y = ImportData_StartProductsColumn To UBound(ImportData, 2)
            
                    AllocData(x, (y - ImportData_StartProductsColumn) + 1) = ImportData(x, y)
                    
                Next y
                
            Next x
            
            shtImportData.Range(Cells(1, LastCol + 1), Cells(LastRow, (LastCol) + UBound(AllocData, 2))) = AllocData
            
            
        End If
    
    
    '// Remove Any Spare 'Empty' Columns...
        FindLastColumn shtImportData
        For x = LastCol To 1 Step -1
        
            shtImportData.Activate
            If Application.WorksheetFunction.CountA(Cells(1, x).Address & ":" & Cells(MaxRowsExcel2003, x).Address) = 0 Then
                shtImportData.Columns(x).Delete
            End If
        
        Next x
    
    
    
    
    '// Close Import File
        importFile.Close False
    
    
    End Sub
    That lies within this module (called ImportWorkbook):

    Code:
    Option Explicit
    Option Private Module
    
    
    Public Function GetImportWorkbookPath() As Variant
    
    
    '// Get File Path Using A Pre-Built Dialog
        GetImportWorkbookPath = Application.GetOpenFilename(FileFilter:="Excel Files,*.xls*", Title:="Please Select Import File", MultiSelect:=True)
    End Function
    
    
    Public Function ValidateImportFilePath(FilePath As String) As Boolean
    
    
    '// Assume Valid Until Proved Otherwise
        ValidateImportFilePath = True
    
    
    '// Validate
        If LCase(FilePath) = "false" Or IsEmpty(FilePath) Then
            ValidateImportFilePath = False
        End If
        
    End Function
    
    
    Public Sub ObtainImportData(importFile As Workbook)
    Dim impData As Variant
    Dim impSheet As Worksheet
    
    
    '// Obtain Data From Import File
        importFile.Activate
        Set impSheet = importFile.Sheets(1)
        impSheet.Activate
        If ImportHasExtraRows = True Then
            impSheet.Range("5:6").EntireRow.Delete
            impSheet.Range("1:3").EntireRow.Delete
        End If
        FindLastRow impSheet
        FindLastColumn impSheet
        impData = impSheet.Range(Cells(1, 1), Cells(LastRow, LastCol))
    
    
    '// Deposit Data Into 'ImportSheet'
        EventCalc.Activate
        With shtImportData
            .visible = xlSheetVisible
            .Activate
            .Range(Cells(1, 1), Cells(LastRow, LastCol)).value = impData
        End With
        
    '// Close ImportFile?
        importFile.Close False
    
    
    End Sub
    
    
    Public Sub ObtainImportDataMultipleWB(importFile As Workbook, FirstWB As Boolean)
    Dim ImportData As Variant
    Dim AllocData As Variant
    Dim ImportSheet As Worksheet
    Dim currentStoreList As Variant
    Dim errmsg As String
    Dim x As Long, y As Long
    
    
    '// Obtain Data From Import File
        importFile.Activate
        Set ImportSheet = importFile.Sheets(1)
        ImportSheet.Activate
        If ImportHasExtraRows = True Then
            ImportSheet.Range("5:6").EntireRow.Delete
            ImportSheet.Range("1:3").EntireRow.Delete
        End If
        FindLastRow ImportSheet
        FindLastColumn ImportSheet
        ImportData = ImportSheet.Range(Cells(1, 1), Cells(LastRow, LastCol))
        
    '// Determine If Is First Import - If so deposit data, if not perform checks and append data!
        If FirstWB = True Then
        
            '// Deposit Data
            EventCalc.Activate
            With shtImportData
                .visible = xlSheetVisible
                .Activate
                .Range(Cells(1, 1), Cells(LastRow, LastCol)).value = ImportData
            End With
                
        Else
        
            '// Obtain List of Stores To Check Against
            EventCalc.Activate
            FindLastRow shtImportData
            currentStoreList = shtImportData.Range(Cells(1, 1), Cells(LastRow, 1))
        
            '// Perform Check - On Mismatch Exit.
            If UBound(currentStoreList, 1) <> UBound(ImportData, 1) Then
                errmsg = "Count of Stores in " & importFile.Name & vbCrLf & "Doesn't Equal Count of Stores In Previous Imported Files - Please Check!"
                CriticalErrorFailure errmsg
                RestoreTemplate
                End
            End If
            
            For x = ImportData_StartAllocationRow To UBound(currentStoreList, 1)
            
                If currentStoreList(x, 1) <> ImportData(x, 1) Then
                    errmsg = "Store: " & currentStoreList(x, 1) & " <> " & ImportData(x, 1) & vbCrLf & "Whilst Attempting To Import: " & importFile.Name
                    CriticalErrorFailure errmsg
                    RestoreTemplate
                    End
                End If
            
            Next x
            
            '// If Stores Match Entirely Copy Only Allocation Data Across (Store Data Not Required)
            FindLastRow shtImportData
            FindLastColumn shtImportData
            
            ReDim AllocData(1 To UBound(ImportData, 1), 1 To UBound(ImportData, 2) - (ImportData_StartProductsColumn - 1))
            
            For x = 1 To UBound(ImportData, 1)
            
                For y = ImportData_StartProductsColumn To UBound(ImportData, 2)
            
                    AllocData(x, (y - ImportData_StartProductsColumn) + 1) = ImportData(x, y)
                    
                Next y
                
            Next x
            
            shtImportData.Range(Cells(1, LastCol + 1), Cells(LastRow, (LastCol) + UBound(AllocData, 2))) = AllocData
            
            
        End If
    
    
    '// Remove Any Spare 'Empty' Columns...
        FindLastColumn shtImportData
        For x = LastCol To 1 Step -1
        
            shtImportData.Activate
            If Application.WorksheetFunction.CountA(Cells(1, x).Address & ":" & Cells(MaxRowsExcel2003, x).Address) = 0 Then
                shtImportData.Columns(x).Delete
            End If
        
        Next x
    
    
    
    
    '// Close Import File
        importFile.Close False
    
    
    End Sub
    Kind regards,

    Doug.

  4. #4
    Board Regular steve the fish's Avatar
    Join Date
    Oct 2009
    Location
    Midlands, UK
    Posts
    7,650
    Post Thanks / Like
    Mentioned
    19 Post(s)
    Tagged
    3 Thread(s)

    Default Re: Run-time error '1004': Method 'Activate' of object '_Workbook' failed only on new PC

    How are you running that sub to give importfile its value? Nowhere within that code do you run that sub.

  5. #5
    Board Regular
    Join Date
    Jul 2016
    Posts
    115
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Run-time error '1004': Method 'Activate' of object '_Workbook' failed only on new PC

    Quote Originally Posted by steve the fish View Post
    How are you running that sub to give importfile its value? Nowhere within that code do you run that sub.
    Hi Steve the fish,

    Just got back from my vacation. The IT dept who own the model emailed me to let me know that they do not wish it altered (it's beyond my level, and it's beyond their capacity to understand also).
    So instead, this morning, I built a model to allow a user to select a folder and convert it's *.xlsx files to *.xls files and vice versa.

    I did have a look for code that runs the sub and couldn't find it, but I was also discouraged from further action.

    Thanks anyway for the time, much appreciated!

    Kind regards,

    Doug.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •