Microsoft Excel は動作を停止しました(0xc0000005)

Question

###前提・実現したいこと
Excelのシート・モジュールのVBAコードをテキストファイルからインポートし、変更するツールをExcelファイルで作成しました。
インポートするテキストファイルの名前と同じ名前のシートまたはモジュールにテキストをインポートする仕組みになっています。

そこで、以下コードの「.AddFromFile src_path & "" & result」を実行すると、
「Microsoft Excel は動作を停止しました」とメッセージが表示され、Excelが停止してしまいます。
ちなみに、「PublicSub.txt」をインポートする際に高確率で発生します。
それ以外のテキストをインポート込む際は発生しません。

どうしても発生する原因がわからないのでご回答いただきたく思います。

###該当のソースコード
↓ソース更新ツール

Private Function source_Update() As Long    '戻り値：更新ファイル数
    
    Dim src_path As String
    Dim wb As Workbook
    Dim tgt_mod As String
    Dim result As String
    Dim i As Long
    Dim j As Long
    Dim objName As String
    
    source_Update = 0
    
    'パスを変数に格納
    src_path = Me.Range("B8").Value '最新ソースフォルダのパス
    
    With Worksheets("対象Excel一覧")
        
        i = 1
        Do While .Range("B" & i).Value <> ""
        
            Application.EnableEvents = False 'イベントの発生を無効
            
            '対象ブックを開く
            Set wb = Application.Workbooks.Open(.Range("B" & i).Value)
            
            '最新ソースフォルダーのテキストファイルを全件取得
            result = Dir(src_path & "*.txt")
            Do While result <> ""
            
                '追加したいモジュール名称
                tgt_mod = Replace(Replace(result, src_path & "\", ""), ".txt", "")
                
                'シート名を検索
                For j = 1 To wb.Worksheets.Count
                    If wb.Worksheets(j).Name Like "*" & tgt_mod & "*" Then
                        objName = wb.Worksheets(j).CodeName
                        With wb.VBProject.VBComponents(objName).CodeModule  'ソース更新
                            .DeleteLines 1, .CountOfLines   'そのモジュール内のコードを削除する
                            .AddFromFile src_path & "\" & result    'テキストファイルから追加する
                        End With
                    End If
                Next
                
                'シート以外のモジュール
                If objName = "" Then
                    objName = tgt_mod
                    With wb.VBProject.VBComponents(objName).CodeModule  'ソース更新
                        .DeleteLines 1, .CountOfLines   'そのモジュール内のコードを削除する
                        .AddFromFile src_path & "\" & result    'テキストファイルから追加する　**←ここでExcelが停止する**
                    End With
                End If
                
                objName = ""
                result = Dir()
                
            Loop
            
            '対象ブックを保存して閉じる
            wb.Save
            wb.Close
            Set wb = Nothing
            Application.EnableEvents = True 'イベントの発生を有効
            
            i = i + 1
        Loop
    End With
    
    source_Update = i - 1
    
End Function

↓PublicSub.txt

Option Explicit

Const SW_SHOWMINIMIZED = 2
Const SW_RESTORE = 9

Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" _
  (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
'Accessを最前面に表示する処理
Public Sub appShowWindow(hWnd As Long)
    Call apiShowWindow(hWnd, SW_SHOWMINIMIZED)
    Call apiShowWindow(hWnd, SW_RESTORE)
End Sub

'自身を削除
Public Sub OwnDelete()

    With ThisWorkbook
        .Save
        .ChangeFileAccess Mode:=xlReadOnly
        Kill .FullName
        Application.Quit
        .Close (False)
    End With

End Sub

'シート指定してPDF出力
Public Sub AllPDF_Convert(FileName As String)

    Dim WSAry() As String
    WSAry = Split(CnvPdfSheets, ",")
    Worksheets(WSAry).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FileName '選択したシートをPDF出力

End Sub


'処理に使用するシート名をセット
Public Sub Set_OperateSheet()
    
    Dim ws As Worksheet
    OperateSheet1 = ""
    OperateSheet2 = ""
    OperateSheet3 = ""
    OperateSheet4 = ""
    OperateSheet5 = ""
    OperateSheet6 = ""
    OperateSheet7 = ""
    OperateSheet8 = ""
    OperateSheet9 = ""
    OperateSheet10 = ""
        
    '分かれる場合のシート名セット
    For Each ws In Worksheets
        If ws.Name Like SheetName1 And OperateSheet1 = "" Then
            OperateSheet1 = ws.Name
            GoTo hit
        End If
        If ws.Name Like SheetName2 And OperateSheet2 = "" Then
            OperateSheet2 = ws.Name
            GoTo hit
        End If
        If ws.Name Like SheetName3 And OperateSheet3 = "" Then
            OperateSheet3 = ws.Name
            GoTo hit
        End If
        If ws.Name Like SheetName4 And OperateSheet4 = "" Then
            OperateSheet4 = ws.Name
            GoTo hit
        End If
        If ws.Name Like SheetName5 And OperateSheet5 = "" Then
            OperateSheet5 = ws.Name
            GoTo hit
        End If
        If ws.Name Like SheetName6 And OperateSheet6 = "" Then
            OperateSheet6 = ws.Name
            GoTo hit
        End If
        If ws.Name Like SheetName7 And OperateSheet7 = "" Then
            OperateSheet7 = ws.Name
            GoTo hit
        End If
        If ws.Name Like SheetName8 And OperateSheet8 = "" Then
            OperateSheet8 = ws.Name
            GoTo hit
        End If
        If ws.Name Like SheetName9 And OperateSheet9 = "" Then
            OperateSheet9 = ws.Name
            GoTo hit
        End If
        If ws.Name Like SheetName10 And OperateSheet10 = "" Then
            OperateSheet10 = ws.Name
            GoTo hit
        End If
hit:
    Next ws
        
    '先か後か？
    If Worksheets(InformationSheet).Range("E1").Value = "後" Then
        
        'PDF化する対象のシートをセット
        CnvPdfSheets = "資料A," & _
                       OperateSheet1 & "," & _
                       OperateSheet2 & "," & _
                       OperateSheet3 & "," & _
                       OperateSheet4 & "," & _
                       OperateSheet5 & "," & _
                       OperateSheet6 & "," & _
                       OperateSheet7 & "," & _
                       OperateSheet8
        
    Else
        
        'PDF化する対象のシートをセット
        CnvPdfSheets = "資料B," & _
                       OperateSheet1 & "," & _
                       OperateSheet3 & "," & _
                       OperateSheet5 & "," & _
                       OperateSheet7 & "," & _
                       OperateSheet8
        
    End If
End Sub

'現在のフォルダ番号を取得
Public Function GetFolderNum(thisFolderPass As String) As Long
    
    GetFolderNum = 0
    
    '現在のフォルダ番号を取得
    Dim A_place As Long
    Dim B_place As Long
    A_place = InStrRev(thisFolderPass, "\") + 1
    B_place = InStr(A_place, thisFolderPass, ".")
    GetFolderNum = Mid(thisFolderPass, A_place, B_place - A_place)

End Function

'指定された範囲内に図形があるか
Public Function ShapeCheck(tergetCell As Range, tergetSheet As Worksheet) As Integer

    ShapeCheck = 0
    
    Dim rngLeft   As Long
    Dim rngTop    As Long
    Dim rngRight As Long
    Dim rngBottom As Long
    Dim objShape As Object
    Dim margin As Long

    ' セル範囲の座標取得
    margin = 10 '余幅
    With tergetCell
        rngTop = .Top - margin
        rngLeft = .Left - margin
        rngBottom = .Top + .Height + margin
        rngRight = .Left + .Width + margin
    End With
    
    ' アクティブシートの図形列挙
    For Each objShape In tergetSheet.DrawingObjects
        ' 範囲内にあるかチェック
        With objShape
            'Debug.Print .Name
            If rngTop <= .Top And rngLeft <= .Left And _
               rngBottom >= .Top + .Height And rngRight >= .Left + .Width Then
                ' 範囲内にあればフラグオン
                ShapeCheck = 1
            End If
        End With
    Next
End Function

###補足情報(言語/FW/ツール等のバージョンなど)
・Excel 2010を使用しています。
・OSはWindows7 32bitです。

始めての質問投稿で至らない点があるとはございますが、
宜しくお願い致します。

Answer 1

自分もバージョン管理ツールを作成する上で、
同様のエラーにあたったことがありました。

原因が全く同じか分かりませんが、
コードを先に削除するとエクセルが不安定で落ちるので、
コードを先に挿入してから
コードの不要部分を除去、
という手順で対応しています。

もし良ければ、ツールを試して頂けると嬉しいです。
http://www.excelsystem.jp/VBAer

Comments

[NT0314]

ご回答いただきありがとうございます！
コード挿入→不要部削除の流れで修正してみます。

これでも直らないようであれば、ツールを試してみたいと思います。

[NT0314]

上記の流れで修正した結果、問題なく処理が続行されるようになりました！
ありがとうございました！