エクセルマクロでFileを開く時エラーが出ます
解決済
回答 2
投稿
- 評価
- クリップ 0
- VIEW 1,348
csv Fileの内容を定期的(10分間隔、2File有るので実質5分置き)にエクセルFileにコピーし
データの内容をグラフ化する処理を行っています。
グラフはエクセルファイルに設定しているのでデータが書き換わる事で更新しています。
1Fileのみで動作させた時は問題無いのですが、2File同時動作させると、8時間程度動作した所で毎回
「実行時エラー1004 'Open' メソッドは失敗しました 'Workbooks' オブジェクト」
が出て停止してしまいます。
どなたか問題がわかる方ご教授いただけないでしょうか。
よろしくお願いいたします。
【確認してみたこと】
◆1Fileのみで動作させた場合は、複数回、2File共、希望している15日間の内14日迄動作を確認しています。
◆Fileを開く前にcsv Fileを開いているのでここでSleep処理を設定(10秒、100秒)して開くのを待ったり、
またPB:PlotBook を開く際にエラーが出ているので、ここでSleep処理(10秒、100秒)等を設定しても発生
◆PB:PlotBookには100個のグラフを描写しているので、そこを20個まで減らして実施しても発生しました。
◆処理時間が長くなっていないかを確認してみましたが、1処理に掛かる時間は25秒程度で
動作している8時間の間変動無しです。
Codeは下記です
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Timer()
'指定の経過時間毎にマクロを走らせるタイマー
Dim mySpan(2160) As Date
Dim span As Date, n As Integer
span = Now + TimeValue("0時00分30秒")
’2つ目を動作させる時はここを+ TimeValue("0時05分30秒") として5分置きに動作
Debug.Print "span =" & span
For n = 0 To 2160 '21600min = 15days
mySpan(n) = span
Application.OnTime span, "CopyPlotandJudge"
span = DateAdd("n", 10, span)
Next
End Sub
Sub CopyPlotandJudge()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'1)エクセルファイルがあるフォルダパスを入力
Call CopyPlot(ThisWorkbook.Path)
'2)メール送信処理
If ThisWorkbook.Worksheets(1).Range("B31") <> "OK" And ThisWorkbook.Worksheets(1).Range("C31") = "OK" Then
Call SendMail
End If
End Sub
Sub CopyPlot(Path As String)
Dim FSO As Object 'FileSystemObjectを定義
Dim sFile As Variant, sCopy As Variant, PFile As Variant 's=ソースファイル とソースコピーファイルを定義
Dim DB As Workbook, DS As Worksheet 'DB:データブック、DS:データシート
Dim PB As Workbook, PS As Worksheet, RS As Worksheet 'PB:PlotBook、PS:Plotデータシート、RS:ResultSheet
On Error GoTo errorhndler
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set FSO = CreateObject("Scripting.FileSystemObject")
'フォルダ内のソースファイルをRename Copy
Debug.Print Now & " の処理です。"
sFile = "\\(IP)\Logdata\" & Left(ThisWorkbook.Name, 5) & "\df_last1000.csv"
sCopy = ThisWorkbook.Path & "\df_last1000Copy.csv"
PFile = ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, 5) & "_PlotSheet.xlsx"
Debug.Print sFile & " To " & sCopy
Debug.Print PFile
FSO.CopyFile sFile, sCopy
'コピーしたソースcsv Fileを定義
Debug.Print Now & " 1"
Set DB = Workbooks.Open(Filename:=sCopy, ReadOnly:=True)
Set DS = DB.Worksheets(1)
'プロットデータブックの読み取り専用を解除
Sleep 1000
SetAttr PFile, vbNormal
Debug.Print Now & " 2"
'プロットデータブックを開き、data Sheetと結果Sheetを定義
Set PB = Workbooks.Open(Filename:=PFile)
’=========毎回ここで停止します。==========
Sleep 10000
Set PS = PB.Worksheets("data")
Set RS = PB.Worksheets("Result")
'ソースcsvからdata Sheetへコピー
DB.Activate
DS.Activate
DS.Range("A2:A1001").Select
DS.Range(Selection, Selection.End(xlToRight)).Copy
PS.Activate
PS.Cells(2, 1).PasteSpecial Paste:=xlPasteValues
DB.Close
'結果Sheetの内容をMacro Sheetへ入力
'前回の判定結果を記録
ThisWorkbook.Worksheets(1).Range("B31").Copy
ThisWorkbook.Worksheets(1).Range("C31").PasteSpecial Paste:=xlPasteValues
Debug.Print Now & " グラフFileの判定結果と最終時間をマクロシートに記載します。"
PB.Activate
RS.Range("B19").Copy
ThisWorkbook.Worksheets(1).Range("B31").PasteSpecial Paste:=xlPasteValues
PS.Cells(Rows.Count, 3).End(xlUp).Copy
ThisWorkbook.Worksheets(1).Range("C28").PasteSpecial Paste:=xlPasteValues
'グラフFileのsheetをアクティブシートに設定
PB.Activate
RS.Activate
' Windows.Arrange ArrangeStyle:=xlArrangeStyleTiled
' Windows("DE_57_PlotSheet.xlsx").Activate
With ActiveWindow
.Width = 500
.Height = 1360
.Top = 0
.Left = 0
.Zoom = 50
End With
PB.Save
PB.Close
'念のためFSOをクリア
Set FSO = Nothing
'読み取り専用に設定し再度開く
SetAttr PFile, vbReadOnly
Set PB = Workbooks.Open(Filename:=PFile)
Set PS = PB.Worksheets("data")
Set RS = PB.Worksheets("Result")
Debug.Print Now & " Windowサイズを修正します。"
PB.Activate
RS.Activate
With ActiveWindow
.Width = 500
.Height = 1360
.Top = 0
.Left = 0
.Zoom = 50
End With
Exit Sub
’この後メール送信Macroが有りますがここでは異常が出ていないので割愛します。
【環境】
Excel 2016 32bit
Windows10 Pro 64bit
-
気になる質問をクリップする
クリップした質問は、後からいつでもマイページで確認できます。
またクリップした質問に回答があった際、通知やメールを受け取ることができます。
クリップを取り消します
-
良い質問の評価を上げる
以下のような質問は評価を上げましょう
- 質問内容が明確
- 自分も答えを知りたい
- 質問者以外のユーザにも役立つ
評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。
質問の評価を上げたことを取り消します
-
評価を下げられる数の上限に達しました
評価を下げることができません
- 1日5回まで評価を下げられます
- 1日に1ユーザに対して2回まで評価を下げられます
質問の評価を下げる
teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。
- プログラミングに関係のない質問
- やってほしいことだけを記載した丸投げの質問
- 問題・課題が含まれていない質問
- 意図的に内容が抹消された質問
- 広告と受け取られるような投稿
評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。
質問の評価を下げたことを取り消します
この機能は開放されていません
評価を下げる条件を満たしてません
質問の評価を下げる機能の利用条件
この機能を利用するためには、以下の事項を行う必要があります。
- 質問回答など一定の行動
-
メールアドレスの認証
メールアドレスの認証
-
質問評価に関するヘルプページの閲覧
質問評価に関するヘルプページの閲覧
checkベストアンサー
+1
さすがに8時間の検証はできないので、コードからの推測によるアドバイスになります。
的外れでしたら申し訳ありません。
ある程度の時間は正常に動作するものが、長期の繰り返し処理の中で異常をきたす、ということですよね。
ざっくりですが、以下のような原因が推測できます。
①処理回数によって変数などがオーバーフローする
⇒エラーが発生する箇所では考え難そう。
②ゴミが貯まってメモリ不足になる
⇒これは可能性ありか?
③処理中の環境変化
・処理遅延により前回のタイマー処理が終わる前に次のタイマー処理が発生した
⇒一回毎の処理は一定間隔(25秒)で終わっているということなので考え難い?
・解放が間に合わずファイルロックされた
⇒解放に5分もかかるのは考え難いか・・・?
・割り込み処理が発生した
・その他の外的要因など
⇒ここらへんになると特定が難しいです。。
また、根本的な問題として
④非常に稀に発生するデータ依存のエラー
という可能性も考えましたが、これもエラー発生個所から見て薄そうです。
個人的には、まずは一番ありそうなところで②を疑っています。
コード内でメモリにゴミを残しそうな記述としては、DB.Close
やPB.Close
などでブックを閉じてはいますが、変数としては明示的に解放していないあたりでしょうか。
大丈夫な気もしますが、基本的にSet
したObjectは再利用する前に明示的に開放Set xx = Nothing
してあげた方が無難な気がします。
さしあたりここら辺を確認されてみてはどうでしょうか。
参考になれば幸いです。
投稿
-
回答の評価を上げる
以下のような回答は評価を上げましょう
- 正しい回答
- わかりやすい回答
- ためになる回答
評価が高い回答ほどページの上位に表示されます。
-
回答の評価を下げる
下記のような回答は推奨されていません。
- 間違っている回答
- 質問の回答になっていない投稿
- スパムや攻撃的な表現を用いた投稿
評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。
+1
直接の回答ではありません、私ならこれを試してみるというだけの物です。
③はぶっちゃけ面倒なので、①②をとりあえず試してみると良いかもしれません。
①処理を定期的にOSに返す
コード中の定期的に通る任意の場所に『DoEvents』を入れる。
②クリップボードのクリア
何かの貼り付けの直後(?)に『Application.CutCopyMode = False』を入れる。
③マクロを開いているエクセルとは別に
別途エクセルアプリケーションを作成し、そこでやりたい処理を行う。
そして定期的にアプリケーションを閉じたり上げたりする。
'注)例は適当です。
Sub Sample1()
Dim myExcel As Object
Set myExcel = CreateObject("Excel.Application")
'■ いろいろ操作 ■
'myExcel.Visible = True
'myExcel.Workbooks.Add
myExcel.Quit
Set myExcel = Nothing
End Sub
投稿
-
回答の評価を上げる
以下のような回答は評価を上げましょう
- 正しい回答
- わかりやすい回答
- ためになる回答
評価が高い回答ほどページの上位に表示されます。
-
回答の評価を下げる
下記のような回答は推奨されていません。
- 間違っている回答
- 質問の回答になっていない投稿
- スパムや攻撃的な表現を用いた投稿
評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。
15分調べてもわからないことは、teratailで質問しよう!
- ただいまの回答率 89.97%
- 質問をまとめることで、思考を整理して素早く解決
- テンプレート機能で、簡単に質問をまとめられる
質問への追記・修正、ベストアンサー選択の依頼
morinatsu
2018/12/19 22:47
これが原因とも思いませんが、PFileを2回オープンしているのに、クローズが1回のみなのが気になりました。
atsunofu
2018/12/20 09:02
morinatsuさん、ご意見ありがとうございます。
最後にPFileを開いた後、表示を継続する必要が有るのでクローズしていませんでしたが、
最初にクローズしていませんでした。クローズ処理を追加して試してみます。