VBA指定時刻に転記保存

   

指定した時刻にマクロを実行する（OnTimeメソッド）

指定した時刻にほかのマクロが起動していると、OnTimeメソッドで指定したマクロを実行できません。

Sub macro1()

a = Workbooks("●●●.xlsm").Worksheets("Sheet1").Range("F165").Value
Workbooks.Open Filename:="C:\Users\●●●\Desktop\マクロ\●●●.xlsx"
Sheets("Sheet2").Select

ActiveCell.Select
ActiveCell.FormulaR1C1 = a
ActiveCell.Offset(0, 1).Select
Workbooks("●●●.xlsx").Worksheets("Sheet2").Cells(3, i + 1) = Now()
i = i + 1
next_time = Now() + TimeValue("00:00:15")

Application.OnTime EarliestTime:=next_time, Procedure:="macro1"

End Sub

↑
元になる15秒繰り返し転記
Sub owarine()
a = Workbooks("●●●.xlsm").Worksheets("Sheet1").Range("F165").Value
Workbooks.Open Filename:="C:\Users\●●●\Desktop\マクロ\●●●.xlsx"
Sheets("Sheet2").Select

Workbooks("●●●.xlsx").Worksheets("Sheet2").Cells(i, 1) = a
i = i + 1

https://tech-draft.net/programming/vba-ontimer/

時間部分を変更する
next_time = Now() + TimeValue("00:00:15")

Application.OnTime EarliestTime:=TimeValue("15:00:01"), Procedure:="owarine"

End Sub

問題は15秒間隔も同時に動いている。取得するデータ自体は同じ。
従って15秒間隔のやつを15時に終了させて閉じる上書き保存のほうがいいのでは？

いずれにせよApplication.OnTime実行からの解除や停止はなんだかめんどくさい。
指定時間に停止ボタンをクリックさせるプロシージャを追加したほうがいいのかもしれない。
そしてさらに指定時間で終値記録させる。

指定時刻に転記保存失敗例

とりあえず終値記録のみをつくってみよう↓以下では動かない

Sub owarine()
a = Workbooks("●●●.xlsm").Worksheets("Sheet1").Range("F165").Value
Workbooks.Open Filename:="C:\Users\●●●\Desktop\マクロ\●●●.xlsx"
Sheets("Sheet2").Select

Workbooks("●●●.xlsx").Worksheets("Sheet2").Cells(i, 1) = a
i = i + 1
next_time = Now() + TimeValue("00:00:15")

Application.OnTime EarliestTime:=TimeValue("15:00:01"), Procedure:="owarine"

End Sub

 

デバッグしてみる　F8連打でもよい

なにをやっても動かない。マクロ自体動いてない？　イミディエイトウィンドウで実行してチェックする
以下で動いた

Sub owarine()
a = Workbooks("転記元.xlsm").Worksheets("Sheet1").Range("G163").Value
Workbooks.Open Filename:="C:\Users\malis\Desktop\マクロ\転記先.xlsx"
Sheets("Sheet1").Select

ActiveCell.Select
ActiveCell.FormulaR1C1 = a
ActiveCell.Offset(0, 1).Select

Application.OnTime TimeValue("17:59:01"), Procedure:="owarine"

End Sub

しかし、エラーがでる。
エラー1004が出たのは複数原因があるようだが、指定したセルの値が不明になっていた（楽天RSSが動いてなかったので）というのも一因にあるようだ。
指定セルを変更（値の入っている）したところ動く。
ということでこのプロシージャにファイルを上書き保存させるコードを付け加える。
いずれにしろ上書き保存させていれば手動でファイルを閉じてもかまわんが。
しかしhttps://www.sejuku.net/blog/68226でやっても動かない。

 

Application.DisplayAlerts

確認メッセージを非表示にする（DisplayAlertsプロパティ）
Application.DisplayAlertsは保存して閉じるまでの処理を囲む必要がある。

とはいえまたエラーがでる。

エラー番号91がでたのでどうやらワークブックにsetをつけてないのでよくないようだ

 

Set book1 = ActiveWorkbook　のように付け加える。book1のところは保存するワークブック名になる。activeをつけていないと動かない。

 

指定時間に特定のセルから別ワークブックに転記し、上書き保存閉じるまでのVBA完成

Sub owarine()
Dim 転記先ファイル As Workbook

a = Workbooks("転記元.xlsm").Worksheets("Sheet1").Range("F165").Value
Workbooks.Open Filename:="C:\Users\●●●●●\Desktop\●●●\ファイル名.xlsx"
Sheets("Sheet1").Select

ActiveCell.Select
ActiveCell.FormulaR1C1 = a
ActiveCell.Offset(0, 1).Select
Application.DisplayAlerts = False

Set 転記先ファイル = ActiveWorkbook
転記先ファイル.Save

転記先ファイル.Close
Application.DisplayAlerts = True

Application.OnTime TimeValue("15:00:01"), Procedure:="プロシージャ名"

End Sub




 - VBA