VBA：从其他工作簿中提取数据后，Excel停止工作

Question

我正在尝试从其他4个工作簿中提取数据（其中一些可能有数千行 ）

提取完成后，Excel停止工作并重新启动。 我在工作表中提取了数据，因此我假设在提取了最后一个工作簿数据后excel发生了变化。

我也只用一个工作簿进行了测试，并且在关闭后崩溃。

我已经读到我们可以在复制/粘贴或关闭工作簿后使用“ DoEvents”和“ Application.Wait”，以使Excel完成一些后台工作。 我已经尝试过了，但是没有成功。

关于Excel为何停止运行/重新启动的任何想法？

这是我的代码：

Public sysExtractParamsDictionary As Scripting.dictionary

'Sub rotine triggered when pressing button
Sub Extract()

    Set sysExtractParamsDictionary = mUtils.FillDictionary("sysParams", "tExtractParams")   'Sub rotine belonging to mUtils module to fill dictionary with values from my sysParams sheet. Contains the sheets name.
    mClean.Clean       'Sub rotine belonging to mClean module to clear sheets
    ExtractData [sysInputDirectory], "Input Sheet"  'Cell Name sysInputDirectory
    ExtractData [sysR2Directory], "R1 Sheet"
    ExtractData [sysR2Directory], "R2 Sheet"
    ExtractData [sysR3Directory], "R3 Sheet"

End Sub

Sub ExtractData(sFilePath As String, sDictionaryKey As String)

    Dim oWorkbook As cWorkBook 'Class Module

    Set oWorkbook = New cWorkBook

    mUtils.SetStatusBarMessage True, "Extracting " & sDictionaryKey & " ..."   'Sub rotine belonging to my mUtils module to set on or off status bar message

    oWorkbook.WorkBookDirectory = sFilePath
    oWorkbook.OpenWorkBook oWorkbook.WorkBookDirectory
    oWorkbook.CopiesSourceSheetValuesToDestinationSheet sysExtractParamsDictionary(sDictionaryKey)
    oWorkbook.CloseWorkBook (False)

    DoEvents
    DoEvents
    Application.Wait (Now + TimeValue("0:00:05"))
    DoEvents

    Set oWorkbook = Nothing

End Sub

'#### Class Module

Private wbWorkBook As Workbook
Private sWorkBookDirectory As String
Private sWorkBookName As String
Private wsWorksheet As Worksheet

Public Property Set Workbook(wbNew As Workbook)
    Set wbWorkBook = wbNew
End Property

Public Property Get Workbook() As Workbook
    Set Workbook = wbWorkBook
End Property

Public Property Let WorkBookDirectory(sFilePath As String)
    sWorkBookDirectory = sFilePath
End Property

Public Property Get WorkBookDirectory() As String
    WorkBookDirectory = sWorkBookDirectory
End Property

Public Property Let WorkBookName(sFileName As String)
    sWorkBookName = sFileName
End Property

Public Property Get WorkBookName() As String
    WorkBookName = sWorkBookName
End Property

Public Property Set Worksheet(wsNew As Worksheet)
    Set wsWorksheet = wsNew
End Property

Public Property Get Worksheet() As Worksheet
    Worksheet = wsWorksheet
End Property

Public Property Let WorkBookDirectory(sFilePath As String)
    sWorkBookDirectory = sFilePath
End Property

Public Property Get WorkBookDirectory() As String
    WorkBookDirectory = sWorkBookDirectory
End Property

'Class Module Function to Open WorkBook
Public Sub OpenWorkBook(sFilePath As String)

    Dim oFSO As New FileSystemObject
    Dim sFileName As String
    Dim sLog As String

    sFileName = oFSO.GetFileName(sFilePath) 'Get the File Name from Path

    If sFileName = "" Then
        sLog = "Error. Not possible to retrieve File Name from Directory."
    Else
        Me.WorkBookName = sFileName
        Set Me.Workbook = Workbooks.Open(sFilePath)
        If wbWorkBook Is Nothing Then
            sLog = "Error opening file: " & Me.WorkBookName
        Else
            sLog = "File successfully openned!"
        End If
    End If

    Set oFSO = Nothing

End Sub

'Class Module Function to Copy Values from source to destination
Public Sub CopiesSourceSheetValuesToDestinationSheet(wsDestinationName As Variant)

    Dim wsDestination As Worksheet
    Dim rStartRange As range
    Dim rFullRangeToPaste As range

    Set wsDestination = ThisWorkbook.Sheets(CStr(wsDestinationName)) ' Destination Sheet
    Set Me.Worksheet = Me.Workbook.Sheets(1) 'Source Sheet

    Set rStartRange = wsWorksheet.range("A1")
    Set rFullRangeToPaste = wsWorksheet.range(rStartRange, mUtils.FindLast(3)) 'FindLast is a function belonging to mUtils module to find the last cell in worksheet
    rFullRangeToPaste.Copy wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp)

End Sub

'Class Module Function to Close Workbook
Public Sub CloseWorkBook(bSaveChanges As Boolean)
    wbWorkBook.Saved = True
    wbWorkBook.Close SaveChanges:=False
End Sub

 '#### End Class Module

我也尝试过不使用类模块（以防对象出现问题），但是我仍然遇到同样的问题。

Sub Extract()
 ExtractCopyClose "C:\MyFiles\InputData.csv", "Input"
End Sub

Sub ExtractCopyClose(sFilePath As String, wsDestinationName As String)

    Dim wb As New Workbook
    Dim wsDestination As Worksheet
    Dim wsSource As Worksheet
    Dim oFSO As New FileSystemObject
    Dim sLog As String
    Dim rStartRange As range
    Dim rFullRangeToPaste As range

    sFileName = oFSO.GetFileName(sFilePath) 'Get the File Name from Path

    If sFileName = "" Then
        sLog = "Error. Not possible to retrieve File Name from Directory."
    Else
        Set wb = Workbooks.Open(sFilePath)
        If wb Is Nothing Then
            sLog = "Error opening file: " & sWorkBookName
        Else
            sLog = "File successfully openned!"
        End If
    End If

    Set oFSO = Nothing

    Set wsDestination = ThisWorkbook.Sheets(wsDestinationName) ' Destination Sheet
    Set wsSource = wb.Sheets(1) 'Source Sheet

    Set rStartRange = wsSource.range("A1")
    Set rFullRangeToPaste = wsSource.range(rStartRange, mUtils.FindLast(3))
    rFullRangeToPaste.Copy wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp)

    wb.Saved = True
    wb.Close SaveChanges:=False

End Sub

Answer 1

我发现我从其他工作簿导入的工作表具有外部连接，并且正在我的工作簿中创建“连接”和新的“引用”。 不知道为什么，但是由于我正在复制所有工作表内容，所以这某种程度上影响了我的Excel并导致它重新启动。

而不是将完整的源工作表复制到我的工作簿中...

 rFullRangeToPaste.Copy wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp)

我只复制了源工作表的值和格式...

Dim rDestinationRange As Range

'the rest of the code in question

rFullRangeToPaste.Copy wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp)

   Set rDestinationRange = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp)
    rFullRangeToPaste.Copy    
    wsDestination.PasteSpecial xlPasteValuesAndNumberFormats

注意：这在我的工作簿从上一个提取中恢复后才起作用（没有断开的外部连接和空引用）。 然后，我在代码中进行了更改并保存。