Worksheet.Copyメソッドでたまにエラーが出る

Question

AccessからExcelを操作しているときにエラーが出たり出なかったりする

処理の流れは以下の通りです。

AppObj = Excelオブジェクト
WbObj = テンプレートシートのあるWorkBook
WsObj = 保存用シート
SaveWbObj = 保存用ワークブック

Call Excel Kill
前の処理の流れで、Excelが残っているとエラーの原因になるのでWScript.shellにexecでEXCEL.EXEをキルしています。

###　エラーが起きるコード
ActiveWorkbook.SaveAs FileName:=Foldername & "" & TName & "_" & Month & "月分.xlsx", FileFormat:=xlWorkbookDefault, Local:=True

エラー内容

リモートサーバーがないか、使用できる状態ではありません。

エラー出現タイミング

初回実行時、エラーが出た後VBEから中断、再度実行すると作成できる。
作成ファイルを開くと元のテンプレート.xlsxの回復ウィンドウが表示される。

試したこと

・WbObj/SaveWbObjをVariantにしたりWorkBook　などにしたりしてみた
・Sleep xxxxを入れてWbObjがセットされるまで、次の処理を待たせたりしたけどダメだった。

DOption Compare Database
Option Explicit

Private Sub 作成開始_Click()

'処理の確認
Dim chk As Integer
    chk = MsgBox("処理を開始してよろしいですか？", vbYesNo + vbQuestion, "確認")
    DoCmd.OpenForm "NOW_PROCESSING"
    If chk = vbYes Then
    


'=========================担当者の抽出===========================

'cntが担当者数、TNArrayが担当者コード(昇順)

Dim db As Database
Dim RS As Recordset
Dim SQL As String
Dim i As Long: i = 0
Dim Cnt As Long
Dim TCArray() As Variant
Dim TNArray() As Variant

SQL = "SELECT DISTINCT 利益一覧.担当者コード,利益一覧.担当者名 FROM 利益一覧 ORDER BY 利益一覧.担当者コード;"

Set db = CurrentDb
Set RS = db.OpenRecordset(SQL, dbOpenSnapshot)
Cnt = RS.RecordCount
ReDim TNArray(Cnt)
ReDim TCArray(Cnt)


Do Until RS.EOF
        TCArray(i) = RS!担当者コード
        TNArray(i) = RS!担当者名
        ''Debug.Print "TCArray(" & i & ")" & RS!担当者コード & "  " & "TNArray(" & i; ")" & RS!担当者名
        RS.MoveNext
        i = i + 1
Loop
Call DBexport(db, RS)

'=========================担当者毎に取引先抽出===========================

Dim AppObj As Excel.Application
Dim WbObj As Excel.Workbook

Dim TName As String          '担当者名  TNArrayの担当者コードを基に抽出
Dim Month As String          '算出月
Dim arMod(2) As Long         '月算出用
Dim CCArray() As Variant     '取引先コード
Dim CNArray() As Variant     '取引先名一覧
Dim CName As String          '顧客名
Dim check As Long            '取引先の処理カウント　cntと一緒になったら次の担当者へ
Dim Sales As Long            '売上(+)
Dim PurChase As Long         '仕入値(-)
Dim Revate As Long           'リベート(+)
Dim GP As Long               '売上総利益(粗利益) GrossProfit
Dim GPM As Double            '粗利率(%) GrossProfitMargin
Dim DF As Long               'EMS(-) EMS
Dim DFCnt As Long            'EMSの項目数
Dim DFArray() As Variant     'EMSの項目格納用
Dim HITDF() As Variant       'EMSの項目格納用(該当諸掛のみ)
Dim DHL As Long              'DHL(-) DHL
Dim DHLCnt As Long           'DHLの項目数
Dim DHLArray() As Variant    'DHLの項目格納用
Dim HITDHL() As Variant       'DHLの項目格納用(該当諸掛のみ)
Dim WP As Long               'その他
Dim WPCnt As Long            'ろう見本代の項目数
Dim WPArray() As Variant     'ろう見本代の項目格納用
Dim HITWP() As Variant       'ろう見本の項目格納用(該当諸掛のみ)
Dim TP As Long               '輸出利益(経費引当後) Trade Profit
Dim TPM As Double            '輸出利益率(経費引当後) TradeProfitMargin
Dim j As Long: j = 0
Dim k As Long: k = 0
Dim l As Long: l = 0         '項目HIT数
Dim m As Long: m = 0         'HIT項目収納カウント数
Dim RC As Long               '得意先別のレコード数(計算に利用)
Dim flg As Boolean           'リベート項目があるかチェックするフラグ
    Dim Item As Variant      '配列からForeachで取出用
    
    
中略


        k = k + 1
        'j = j + 1
        check = check + 1
        
        'ファイル作成プログラムに投げる
        Call FileMaker(Foldername, Cnt, TName, Month, CName, Sales, PurChase, Revate, Lavel, IP, GP, GPM, EFC, CF, DF, DHL, SF, SP, WP, TP, TPM, HITScode(), HITIP(), HITEFC(), HITCF(), HITDF(), HITDHL(), HITSF(), HITSP(), HITWP(), EFCArray(), CFArray(), DFArray(), DHLArray(), SFArray(), CCArray(), TCArray(), SPArray(), WPArray(), AppObj, WbObj)
    Loop
    
    '変数の初期化
    k = 0
    j = 0
    check = 0

Next i

    '処理中フォームの非表示
    DoCmd.Close acForm, "NOW_PROCESSING"
    
    'AppObj.Quit
    Set AppObj = Nothing
    
    '作成フォルダを開く
    Dim rc2 As Integer
        rc2 = MsgBox("処理が完了しました。ファイルを確認しますか？", vbYesNo + vbQuestion, "確認")
        If rc2 = vbYes Then
        Shell "C:\Windows\Explorer.exe " & Foldername, vbNormalFocus
        Call ExcelKill
    End If
    
    
'処理の確認=False
Else

    Exit Sub

End If
End Sub

'データーベースとレコードセット開放
Private Sub DBexport(db As Database, RS As Recordset)

    RS.Close
    db.Close
    Set db = Nothing
    Set RS = Nothing

End Sub

'データベースとレコードセットの登録
Private Sub DBSet(db As Database, RS As Recordset, SQL As String)

    Set db = CurrentDb
    Set RS = db.OpenRecordset(SQL, dbOpenSnapshot)

End Sub

'配列内の重複値削除用
Function DeleteSameValue(ar() As Variant) As Variant
    Dim i                   '// ループカウンタ１
    Dim ii                  '// ループカウンタ２
    Dim iLen                '// 配列要素数
    Dim arEdit()            '// 編集後の配列
    Dim iEdit               '// 編集後配列のインデックス
    Dim flg     As Boolean  '// 重複有無判定フラグ（True：重複あり、False：なし）
    
    If IsArrayEx(ar()) = 1 Then
    ReDim arEdit(0)
    iLen = UBound(ar)
    
    '// 配列ループ
    For i = 0 To iLen
        '// 重複有無判定フラグを重複なしとして初期化
        flg = False
        
        '// 重複除去済みの編集後配列ループ
        For iEdit = 0 To UBound(arEdit)
            '// 編集後配列に格納済みの場合
            If (ar(i) = arEdit(iEdit)) Then
                flg = True
                Exit For
            End If
        Next
        
        '// 現ループの値には重複がない場合
        If (flg = False) Then
            '// 重複がない値のみを編集後配列に格納する
            arEdit(UBound(arEdit)) = ar(i)
            ReDim Preserve arEdit(UBound(arEdit) + 1)
        End If
    Next
    
    '// 配列に格納済みの場合
    If (IsEmpty(arEdit(0)) = False) Then
        '// 余分な領域を削除
        ReDim Preserve arEdit(UBound(arEdit) - 1)
    End If
    
    '// 引数に編集後配列を設定
    ar = arEdit
    Else
    End If
End Function

'***********************************************************
' 機能   : 引数が配列か判定し、配列の場合は空かどうかも判定する
' 引数   : varArray  配列
' 戻り値 : 判定結果（1:配列/0:空の配列/-1:配列じゃない）
'***********************************************************
Public Function IsArrayEx(varArray As Variant) As Long
On Error GoTo ERROR_

    If IsArray(varArray) Then
        IsArrayEx = IIf(UBound(varArray) >= 0, 1, 0)
    Else
        IsArrayEx = -1
    End If

    Exit Function

ERROR_:
    If Err.Number = 9 Then
        IsArrayEx = 0
    End If
End Function

Option Compare Database
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Rem ----------------------------------------------------------------------------------
Rem     関数名   : FileMaker
Rem     処理内容 : 担当者毎の取引先シート別EXCELファイル作成
Rem     引  数　 :
Rem     戻り値　 : 無
Rem     メ　モ　 : 'Form_CODE_LINKから項目名を受け取りEXCELファイル作成←配列渡しのがスマートかも？課題
Rem ----------------------------------------------------------------------------------
Function FileMaker(Foldername As String, Cnt As Long, TName As String, Month As String, CName As String, Sales As Long, PurChase As Long, Revate As Long, Lavel As Long, IP As Long, GP As Long, GPM As Double, EFC As Long, CF As Long, DF As Long, DHL As Long, SF As Long, SP As Long, WP As Long, TP As Long, TPM As Double, HITScode() As Variant, HITIP() As Variant, HITEFC() As Variant, HITCF() As Variant, HITIDF() As Variant, HITDHL() As Variant, HITSF() As Variant, HITSP() As Variant, HITWP() As Variant, EFCArray() As Variant, CFArray() As Variant, DFArray() As Variant, SFArray() As Variant, DHLArray() As Variant, CCArray() As Variant, TCArray() As Variant, SPArray() As Variant, WPArray() As Variant, AppObj As Excel.Application, WbObj As Excel.Workbook)


Dim WsObj As Excel.Worksheet        '保存シート
Static SaveWbObj As Excel.Workbook  '保存ブック
Dim Item As Variant                 '配列取出用
Dim j As Long: j = 1                'シート名重複
Dim CNameStr As String              '顧客コード整形用
Static i As Long                    '取引先の数
Static column As Long               '横列
Static rows   As Long               '縦行
Static CompanyCnt As Long           '取引先数
Static flg As Boolean               '初回用

If flg = False Then
        'Call ExcelKill
'        Set AppObj = CreateObject("Excel.Application")
'        Set WbObj = AppObj.Workbooks.Open(Application.CurrentProject.Path & "\【削除不可】利益算出表テンプレート.xlsx")
        AppObj.Visible = False
        flg = True
        Sleep 1000
        
End If
                    
If i = 0 Then       '初回
        CompanyCnt = Cnt '取引先数を受け取る
        column = 2
        rows = 5
        Sleep 1000
        Set SaveWbObj = AppObj.Workbooks.Add(1)
        Debug.Print AppObj
        'Debug.Print WbObj
End If
        Sleep 1000
        'With オブジェクト変数が設定されていません。エラーがたまにでる
        WbObj.Sheets("テンプレート").Copy After:=SaveWbObj.Worksheets(1)
        Set WsObj = SaveWbObj.ActiveSheet
        
        If SaveWbObj.Sheets(1).Name = "Sheet1" Then
            SaveWbObj.Sheets("Sheet1").Delete
        End If
        'Set SaveWbObj = ActiveWorkbook
        
        WsObj.Range("B2").Value = TName
        WsObj.Range("B3").Value = Month
        
中略
        
        
        '書出位置初期化
        column = 2
        rows = 5


    CNameStr = Left(CCArray(i) & "_" & CName, 31)
    SaveWbObj.ActiveSheet.Name = CNameStr
    i = i + 1
    If CompanyCnt = i Then

    i = 0
    j = 0
    '終了時にファイルの保存
    AppObj.Application.DisplayAlerts = False
    SaveWbObj.Sheets(1).Select
    ActiveWorkbook.SaveAs FileName:=Foldername & "\" & TName & "_" & Month & "月分.xlsx", FileFormat:=xlWorkbookDefault, Local:=True
    SaveWbObj.Close
    Set SaveWbObj = Nothing
    AppObj.Application.DisplayAlerts = True
    
    If TName = "TRAN MINH DUC" And i = 0 Then
        WbObj.Close SaveChanges:=False
        Sleep 1000
        AppObj.Quit
        Set AppObj = Nothing
        Set WbObj = Nothing
        'Call ExcelKill
    End If
    
End If
End Function

Answer 1

Static WbObj As Workbookとオブジェクトを静的変数で宣言している目的は何でしょうか。

静的変数で宣言すると、プロシージャを抜けてもオブジェクトが解放されずにメモリ上に残ります。
コードで明示的に解放すればいいかも知れませんが、プロシージャを抜ける前に解放するなら、Dim で宣言したほうがいいように思います。

前の処理の流れで、Excelが残っているとエラーの原因になるのでWScript.shellにexecでEXCEL.EXEをキルしています。

これも、外部から強制的にキルしても、変数のメモリ上の領域は残りますので、
VBAのコードできちんとExcelを終了してメモリ領域も開放すべきだと思います。

Comments

[kingkamehameha]

回答有難う御座います。
WbObjはテンプレートブックなので、一度こちらのExcelファイルに書き起こすFunctionに飛んできた後、フォームに戻るのでその際に変数が初期化されてしまわないようにしています。

WbObj → SaveWbObjにシートをコピーする段階でエラーが起きているようです。元のWbobjを参照出来ていないのか、SaveWbObjを参照出来ていないのか不明です。

全ての処理が終わった時には、ワークブック=Close、オブジェクト=Quitした後、Set 変数 = Nothingで解放しています。

[hatena19]

WbObjをフォームの方でも使用するということでしょうか。Static宣言したら、そのFunction内でしか使えないはずですが。
AppObjはDIm宣言して、それからWbObjを開いているので、親のエクセル（AppObj）は解放されてしまうので、その辺も危険な気がします。

Functionの外でも使いたいなら、グローバル変数にするか、引数で渡す設計にすべきだと思います。

[kingkamehameha]

WbObj自体はフォームの方では使用しないのですが、繰り返し処理の為またこちらに戻って来ることを想定してずっとそのままにしていたつもりでした。確かに親のObject(AppObj)を解放してしまうと危険ですね。ここはまだエラーが出ておりませんでしたが、修正したいと思います。

[kingkamehameha]

ここら辺でEXCELを指定するのか、EXCEL.Applicationの変数を指定するのかイマイチわかっていない所も原因のひとつかと思っています。

[hatena19]

その関数がフォームからのみ呼び出されるのなら、フォームモジュールの宣言部でEXCEL.Application、EXCEL.Workbook の変数を宣言して、関数には引数で、Workbook オブジェクトをわたす設計が安全だと思います。
フォームのUserForm_Initialize() で各オブジェクトのインスタンスを生成して、UserForm_Terminate() でオブジェクトを開放するようにします。

もし、複数の場所から呼び出されるなら、標準モジュールでグローバル変数として宣言することになりますが、バグのもとになるので推奨はできません。

[kingkamehameha]

そのフォーム内ではEXCELに関連する処理は一切記載しておらず、フォーム内で計算の結果や配列などをこのモジュールに渡し、このモジュール内で計算の結果やモジュールを基にEXCELに書き起こしています。
毎回でるエラーも様々で、初回2回目限らずでるので、途方に暮れています。

[hatena19]

そのフォーム内でエクセルを使用してなくても、そのフォームから関数を呼び出していて関数内でブックを利用する。関数はフォームから繰り返し呼び出す、その場合、前の呼び出しの時と同じブックである。というのなら、やはり、フォームのモジュールで宣言すべきだと思います。

[kingkamehameha]

そのような処理にしてみました。
それよりも、Activebookと暗示的に記述していた部分を明示的にBook名の変数を指定しました。

Answer 2

実際に発生したエラーメッセージを追記して頂くと、調査が捗ると思いますが、

Static WbObj As Workbook
を
Static WbObj As Excel.Workbook
に変更しても変わりませんか？

自身のACCESS-VBAである時期から突然エラーが発生し、As WorkBook を As Excel.Workbookに変更して回避したことがありました。

Comments

[kingkamehameha]

回答ありがとうございます。一応Objectで宣言していた CreateObject(EXCEL)/Workbook/Worksheet辺りは全てそれぞれの型に宣言し直しました。