Access VBA [リモートサーバーがないか使用できる状態ではありません]

Access VBA で　Excel のシートにAccess のテーブルの内容をエクスポートする記述で
３ヶ月ほど順調に動いていたのですが年明けよりタイトルのようなエラーがでます
しかし　VBAエディターでブレークポイントを指定して1ステップずつ処理すると
正常に終わります
コマンドボタンから実行すると必ず出ます
このような症状で思い当たる原因と対処法がおわかりの方がいらっしゃいましたら
教えていただきたいと思います　よろしくお願いします

質問者からの補足コメント

• ありがとうございます　
  1を試してみましたが１回目はうまくいきましたが２回目以降同様のエラーがでます
  2だと思います　コードを提示したいのですが　多すぎて文字数が超えてしまいましたので
  処理の内容をお伝えします
  1）まずひな形になるエクセルを別の場所にコピーしています
  2）コピーしたエクセルにクエリの内容をエクスポートしています
  3）コマンドボタンの種類によって開くシートを判断しエクセルを開きます
  これで完了です
  1）の部分でエラーが出たケースがありましたのでこの手前で　Sleep 1000 '1秒待機を入れました
  気になる部分があればコードを提示して解明していただきたいのですが　よろしくお願いします

  No.1の回答に寄せられた補足コメントです。 補足日時：2024/01/22 13:25

• 現在は　2）と3）あたりでエラーがでるようです

    補足日時：2024/01/22 13:27

• ありがとうございます
  確認事項
  1エクセルBookファイルサイズはコピー元　103KB コピー先 111KB
  2両方ともPCローカル内
  3エラーナンバー　462　「リモートサーバーがないか使用できる状態ではありません」
  4タスクマネージャのプロセスにエクセルはあります
  補足では400文字までです
  コード①
  P1 = DLookup("Path1", "M_kanri")
  P2 = DLookup("Path2", "M_kanri")
  myXLName1 = P1 & "\01作業員名簿.xls"
  myXLName2 = P2 & "\作業員名簿.xls"
  Sleep 1000
  FileCopy (myXLName1), (myXLName2)
  strmsg = "MS Excelへデータを出力します"
  intmsg = MsgBox(strmsg, 17, "管理者")　②へ続く

  No.2の回答に寄せられた補足コメントです。 補足日時：2024/01/22 21:29

• コード②
  If intmsg = 1 Then
  DoCmd.SetWarnings 0
  DoCmd.OpenQuery "Q_meibo"
  Set DB = CurrentDb
  Set RS = DB.OpenRecordset("T_01")
  Set objEXE = CreateObject("Excel.Application")
  objEXE.Workbooks.Open (myXLName2)
  objEXE.Worksheets("DATA").Select
  objEXE.Cells(3, 2).CopyFromRecordset RS
  objEXE.Quit
  If Dir(myXLName2) = "" Then
  MsgBox "「" & myXLName2 & "ファイルが見つかりません。」", vbOKOnly
  Exit Sub
  End If　③へ続く

  No.3の回答に寄せられた補足コメントです。 補足日時：2024/01/22 21:38

• コード③
  On Error Resume Next
  Set MyXL = GetObject(, "Excel.application")
  If Err.Number <> 0 Then
  Err.Clear
  Else
  On Error GoTo Err_copyXLSheet
  For Each objEXE In objEXE.Workbooks
  If objEXE.Name = Dir(myXLName2) Then
  objEXE.Close SaveChanges:=False
  End If
  Next objEXE
  End If
  Set MyXL = Nothing
  On Error GoTo Err_copyXLSheet
  Set MyXL = CreateObject("Excel.Application")
  ④へ続く

    補足日時：2024/01/22 21:45

• コード④
  Set objEXE = MyXL.Workbooks.Open(myXLName2)
  With objEXE
  .Application.Visible = True
  .Activate
  If B = 1 Then
  .Worksheets(1).Activate
  Else
  .Worksheets(2).Activate
  End If
  End With
  Set objEXE = Nothing: Set MyXL = Nothing
  Set RS = Nothing
  Set DB = Nothing
  Else
  MsgBox "処理を中止しました", 1, "管理者"
  End If
  DoCmd.SetWarnings -1
  Exit_copyXLSheet:
  Exit Sub
  ⑤へ続く

    補足日時：2024/01/22 21:48

• コード⑤
  Err_copyXLSheet:
  　MsgBox Err.Description
  　Resume Exit_copyXLSheet
  
  End Sub　
  以上です
  変数の宣言部分は省きました
  文字数の関係でインデントを省いたのでかなり見にくくなっております
  エクセルの保存のダイアログが出て保存するボタンを押したあとにエラーがでます
  宜しくお願いします

    補足日時：2024/01/22 21:53

• ありがとうございます
  >Microsoft Excel xx Object Library に参照設定してますかね？
  設定しております
  >変数宣言部も含めて、Sub ～ EndSubまで欲しかったです。
  先にお送りしたコードで前半省いた分を記述します
  Sub copyXLSheet()
  On Error GoTo Err_copyXLSheet
  Dim MyXL As Object
  Dim myXLName1 As String
  Dim myXLName2 As String
  Dim DB As DAO.Database
  Dim RS As DAO.Recordset
  Dim objEXE As Object
  Dim strmsg As String
  Dim intmsg As Integer
  Dim P1 As String
  Dim P2 As String

  No.4の回答に寄せられた補足コメントです。 補足日時：2024/01/24 10:33

• >ざっと見ですが？？？な所がありますが
  知識のなさを痛感しております　エラーがでるたびに検索して同様のエラーを解決した人のサイトを見つけコピペしてエラーを消していくということを繰り返した結果のコードで恥ずかしい限りです
  >※エラーの内容を知りたいところですが・・・。
  エラーナンバー　462　「リモートサーバーがないか使用できる状態ではありません」
  です
  ご紹介のサイトもよく見て参考にさせていただきます

    補足日時：2024/01/24 10:36

No.5 ベストアンサー 回答者： nicotinism 回答日時： 2024/01/25 13:07

遅くなりました。

コンパイルエラーにはなりませんが、はっきり言って自信はありません。
意図しない結果になるかもしれませんので
バックアップを取ってからお試しを。

Sub copyXLSheetのテスト()
'要参照設定 Microsoft Excel xx.x Object Library
'On Error GoTo Err_copyXLSheet
Dim MyXL As Excel.Application, MyBK As Excel.Workbook, MySHT As Excel.Worksheet
Dim myXLName1 As String
Dim myXLName2 As String
Dim DB As DAO.Database
Dim RS As DAO.Recordset
Dim P1 As String
Dim P2 As String
Dim B As Variant '？

P1 = DLookup("Path1", "M_kanri")
P2 = DLookup("Path2", "M_kanri")
myXLName1 = P1 & "\01作業員名簿.xls"
myXLName2 = P2 & "\作業員名簿.xls"
'myXLName1 = "e:\tmp\book1.xlsx"
'myXLName2 = "e:\tmp\book2.xlsx"

'---------------作業に入る前のチェック
On Error Resume Next
'err.Raise 11
'myXLName1 のチェック
Name myXLName1 As myXLName1 '同名ファイルで上書きしてエラーになれば使用中

Select Case Err.Number
Case 0
'エラーではないので続行
Case 53
MsgBox "「" & myXLName1 & "ファイルが見つかりません。」", vbOKOnly
Case 75
'当方ではファイル使用中の場合に”パス名が無効です”のメッセージ
MsgBox "「" & myXLName1 & "は使用中です。閉じてね」", vbOKOnly
Case Else
Debug.Print Err.Number, Err.Description
MsgBox "未対応のエラーが発生しました！作業を中断して" & vbCrLf _
& "何もせずに管理者にご連絡ください"
End Select

If Err.Number <> 0 Then
Exit Sub
End If

'myXLName2 のチェック
Name myXLName2 As myXLName2
Select Case Err.Number
Case 0
'エラーではないので続行
Case 70
'当方ではファイル使用中の場合に”書き込みできません”のメッセージ
MsgBox "「" & myXLName2 & "は使用中です。閉じてね」", vbOKOnly
Case Else
Debug.Print Err.Number, Err.Description
MsgBox "未対応のエラーが発生しました！作業を中断して" & vbCrLf _
& "何もせずに管理者にご連絡ください"
End Select

If Err.Number <> 0 Then
Exit Sub
End If
'------------------作業開始
On Error GoTo 0

If MsgBox("Excelへの出力を始めますか", vbOKCancel, "管理者") = vbCancel Then
MsgBox "処理を中止しました", vbOKOnly, "管理者"
Exit Sub
End If
FileCopy (myXLName1), (myXLName2)

Set DB = CurrentDb
Set RS = DB.OpenRecordset("T_01")

Set MyXL = CreateObject("excel.application")
Set MyBK = MyXL.Workbooks.Open(myXLName2)
Set MySHT = MyBK.Worksheets("DATA")
' DoCmd.SetWarnings 0
DoCmd.OpenQuery "Q_meibo" '←これはなに？
MySHT.Cells(3, 2).CopyFromRecordset RS
'sleep必要かも
MyBK.Save
If B = 1 Then 'このBはどこから？
MyBK.Worksheets(1).Activate
Else
MyBK.Worksheets(2).Activate
End If
MyXL.Visible = True
MyXL.UserControl = True '処理を人間に渡します

Set MySHT = Nothing: Set MyBK = Nothing: Set MyXL = Nothing
RS.Close: Set RS = Nothing
Set DB = Nothing
Exit Sub

Err_copyXLSheet:
Debug.Print Err.Number, Err.Description
Stop
'Resume Exit_copyXLSheet
End Sub

この回答へのお礼

ありがとうございます
何度試してもエラーはでず　ちゃんと動きました
回答いただいたコードについてさらに理解を深めて
今後に役立てていきます
長い間　丁寧なご回答ありがとうございました

お礼日時：2024/01/25 20:45

No.4 回答者： nicotinism 回答日時： 2024/01/23 21:53

変数宣言部も含めて、Sub ～ EndSubまで欲しかったです。

回答する上で実行時エラーは無理でもコンパイラエラーの
凡ミスは避けられますので、回答をそちらでコピペッタンして
確かめやすくもなります。
ざっと見ですが？？？な所がありますが
直接的な回答は今日は勘弁してください。
～保存するボタンを押したあとにエラーがでます
はUsercontrolについて調べれば解決するかも？
※エラーの内容を知りたいところですが・・・。

取りあえず、以前にとても参考になったサイトを載せておきます。
VBAはVB6を元にして開発されたので共通する部分があります。
Visual Basic 中学校 > VB6 テクニック >
１５．消えないExcelのプロセス
http://rucio.a.la9.jp/main/technique/teq_15.htm

行頭のタブインデントや半角スペースはこのサイトでは無視されてしまいます。
コードのやり取りには向かないですね。
回答するときにタブインデントを全角スペースに変換して
やり取りしたことが何度かあります。
VBAでは行頭に全角スペースがあってもエラーになることは経験ありません。
今日はこの辺で。
ps.
Microsoft Excel xx Object Library に参照設定してますかね？

No.3 回答者： nicotinism 回答日時： 2024/01/22 20:48

こちらに残りのコードを。

ついでに、質問時と補足時のそれぞれの文字数制限値を教えてください。

No.2 回答者： nicotinism 回答日時： 2024/01/22 20:45

正確な情報が少ないのでどうしようもありませんね。

この回答の他にもう一つ回答しますので、
それぞれの補足に問題のコードを分割して載せてください。
二つあれば足りる？
その際に個人情報などは適宜書き換えてください。

また、下記確認事項も教えてください。
１・エクセルBookのファイルサイズ
２・BookとAccdbは両方とも自PC内にあるのか
３・エラーになった場合に発生行、Err.number,Err.descriptionの
確認は出来ていますか
４・前回回答の
>※ステップ実行して無事終了しExcelが立ち上がっていない状態で
>タスクマネージャーのプロセスにExcelが無ければ、
はどうなっていますか
以上４件。

No.1 回答者： nicotinism 回答日時： 2024/01/21 22:52

三か月ほどはエラーも無く処理できていたことから推測。

１・xlsxファイルのサイズが大きくなり完全に開ききれていない
or ネットワーク上の問題で遅延・・・などにも関わらず
VBAのコードが進むため。
あるいは
２・Excelオブジェクト内の参照が不十分なコードで
今まではAccessVBAが自動的にカバーしていたのが追いつかなくなった。

１の場合はエラーになる前の行で待ち時間を入れれば対症療法的ですが
解決するかもしれません。
Access VBAの標準モジュールの宣言部に
Option Compare Database
Option Explicit
'ミリセカンドで停止
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
としておいて
エラーになる行の前に以下を追加
Sleep 1000 '1秒待機
としてみては？

２の場合は実際のコードを提示してもらわないと話が進まなそう。
※ステップ実行して無事終了しExcelが立ち上がっていない状態で
タスクマネージャーのプロセスにExcelが無ければ、
２の考慮は無用と思います（多分）。