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
回答2件
あなたの回答
tips
プレビュー