• ベストアンサー

VB6でスケジュールを組みたいのですが

一定の時刻に一定の操作をさせるプログラムを作りました。一応動くようですが不安です。邪道でしょうか。VB6、OSはXPです。 無限ループ: While Time <> "12:30:00" And Time <> "15:30:00" DoEvents Wend If Time = "12:30:00" Then 仕事A ElseIf Time = "15:30:00" Then 仕事B End If GoTo 無限ループ:

noname#62128
noname#62128

質問者が選んだベストアンサー

  • ベストアンサー
noname#58606
noname#58606
回答No.3

Delphiしか経験がないのですが、CPUの負荷率ってどうなってます? あとは、終了させる時とか、一度無限ループをオフにしないと、素直に終了できないような。 CPUの負荷が高いと、同じソフト内の処理も、もたつきますから。 あまり格好いい処理とは言えないと思います。 今簡単に1秒でどれだけループするか、カウントしてみたら、へっぽこノートでさえ、1秒に1800回ループしてました。 アイディアは、斬新なんですけどねー。 もし、無限ループで突き進むのなら、せめて、スレッド化しないと、作り込めば作り込むほど、不確定要素のあるソフトになっちゃいますよ。 ここはセオリー通りに、Timerで1秒ごとにチェックを入れて、時間を確認。 予定の時間だったら、起動した方が、簡単で楽で、楽しいですよ。 プログラムを作る時は、負荷(CPU、メモリ)は小さく、より簡単に、より楽に、出来るように、がポイントです。w 一応、VBでタイマーで調べてみたら、Delphiと同じ Timer.Interval = 1000 '** 1000 ミリセカンド、つまり、1 秒 なので、理論上1ミリセカンドまでOKなので。 (ミリセカンドになると、精度が怪しくなってくると聞きますが。

noname#62128
質問者

お礼

>ここはセオリー通りに、Timerで1秒ごとにチェックを入れて、時間を確認。 難しく考えていました。これでいきます。ありがとうございました。

その他の回答 (2)

  • nda23
  • ベストアンサー率54% (777/1415)
回答No.2

Timerを使い、Timerイベントで処理するようにします。 VBに限らず、Windowsではイベントドリブンなプログラムを心がけるべきです。 また、DoEventsを使わなければならないような処理も極力避けるべきです。 尚、Time = "12:30:00"というのは正しく記述すると、 Format(Time, "HH:NN:SS") = "12:30:00"です。

noname#62128
質問者

お礼

>Format(Time, "HH:NN:SS") = "12:30:00" はい。使わせていただきます。 Timerを使うとうのは、やはり間隔を縮めていくということでしょうか。 DoEventsはやはり重くなるんですね。 ありがとうございました。

noname#60992
noname#60992
回答No.1

素人目に見てもCPU使用率を上げるにはもってこいの方法ですね。 秒単位での起動が必要でないなら、タイマーコントロールで 一分間隔で時間を調べ起動させるとCPUはかなり休めるかな。 秒単位での起動が必要なら、時間が近くなったら、徐々にタイマーの 間隔を縮めていき、数秒前にこのようなループに入れてやるとかの 配慮が必要と思います。

noname#62128
質問者

お礼

秒単位で必要なんです。 Timerにこんな機能がついていれば問題ないのですが。 徐々につめるプログラムも検討したいと思います。 ありがとうございました。

関連するQ&A

  • オブジェクト変数または With ブロック変数が設定されていません。

    下記の様に組みましたが、下記の★印の所で止まる様な事があります。 毎回止まるわけではないのですが、止まる時に「オブジェクト変数または With ブロック変数が設定されていません。」と表示されますが、 原因は何か?どの様にすればいいのか?など詳しく教えてください。 よろしくお願いします。 Sub test() Dim objIE As Object Dim strCOMMENT As String Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = True objIE.Navigate "http://" While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop 'データをセットする 'htmlドキュメント フォーム(0番目) アイテムに転記(代入)する objIE.Document.forms(0).Item("username").Value = "11111" objIE.Document.forms(0).Item("password").Value = "11111" While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop objIE.Document.all.subm.Click While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop For Each link In objIE.Document.Links If link.href = "http://" Then link.Click End If Next While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop 'タイトル・コメントの読み込み strtitle = Sheets("sheet1").Range("k7") strCOMMENT = Sheets("sheet1").Range("k9") Application.WindowState = xlMinimized While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop objIE.Document.forms(0).Item("title").Value = strtitle objIE.Document.forms(0).Item("comment").Value = strCOMMENT While objIE.readystate <> 4 While objIE.busy = True DoEvents ' Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop objIE.Document.all.submit.Click While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop 'フォーム(0番目)を .Submit(確認) する objIE.Document.forms(0).getElementsByTagName("input")(11).Click '←★この部分で止まる時があります。 While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop For Each link In objIE.Document.Links If link.href = "http://" Then link.Click End If Next While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 7, Now()) Do While Now() < Wait_Time DoEvents Loop objIE.Quit '.Quitで閉じる End Sub

  • VB Forから抜ける

    Data1(1, 1) = "りんご" Data1(1, 2) = "みかん" Data1(2, 1) = "なし" Data1(2, 2) = "オレンジ" Data2(1, 1) = "バナナ" Data2(1, 2) = "みかん" Data2(2, 1) = "なし" Data2(2, 2) = "いちご" -------------------- Dim c, i As Integer For c = 1 To 2 For i = 1 To 2 If Data1(c, i) <> Data2(c, i) Then MessageBox.Show("異なります") GoTo goto1 End If Next Next goto1: ----------------- 言語 VB.NET Data1とData2 の中身が異なればアラートを出す。 (複数異なっていても1度のみアラートを出す) さて これを「GOTO」を使わないでする方法ってあるんでしょうか? 「EXIT Sub」はgoto1:の下にもコードがあるので使えません。 GoTo goto1を Exit For にしても 「i」 のループが抜けるだけです。 これを「C」のループを抜けるようなコードってあるんでしょうか?

  • VBでのIE操作

    VBでのIE操作をしようとして色々調べています。 色んなサイトを見ながら途中までは何とかできましたが、どうしてもリンク先を表示できません。 お分かりになる方いましたら、お力添えいただければ幸いです。 状況: Excel2007使用  IE7  VB初心者です。 やりたい内容: VBでIEを立ち上げる ↓ ページからリンクをクリックする (ページ上に画像が貼り付けてあって、そこにURLくっついててハイパーリンクになっている。) (セキュリティの関係でハイパーリンク先を初期で表示することはできない。) ↓ 表示されたページに検索したい項目を入力 ↓ 結果をエクセルに反映する。 以上の作業をVBで組もうと思ってます。 よろしくお願いします。 Option Explicit Sub ie_test() 'IEの起動 Dim objIE As Object Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True '処理したいページを表示します。 objIE.navigate "処理したいページ" 'ページの表示待ち While objIE.readyState <> READYSTATE_COMPLETE Or objIE.Busy = True DoEvents Wend '開かれたIEを探す。 Dim objSHELL As Object Dim objWINDOW As Object Dim newIE As InternetExplorer Dim wait_time As Date Dim yCNT As Long Dim i As Integer '表示待ち wait_time = DateAdd("s", 2, Now()) Do While Now() < wait_time DoEvents Loop 'リンクの貼ってある画像をクリック For i = 0 To objIE.document.images.Length - 1 If InStr(objIE.document.images.Item(i).outerHTML, "image/btn131b1.gif") > 0 Then objIE.document.images.Item(i).Click End If Next '表示待ち wait_time = DateAdd("s", 2, Now()) Do While Now() < wait_time DoEvents Loop 'シェルのオブジェクトを作成する Set objSHELL = CreateObject("Shell.Application") Set newIE = objSHELL.Windows(objSHELL.Windows.Count - 1) Set objSHELL = Nothing '新しいウィンドウのログインボタンを押す Dim objINPUT As Object 'Inputタグ格納用 For Each objINPUT In newIE.document.all.tags("INPUT") If objINPUT.Value = "ログイン" Then objINPUT.Click Exit For End If Next '調べる項目 For yCNT = 3 To 1002 ' If Trim(Cells(yCNT, 1)) = "" Then Exit For 'A列が空白になったらループを抜ける 'ページが表示されたので処理を行います。 newIE.document.all("phone_no").Value = Cells(yCNT, 1) 'A列の文字を参照する newIE.document.all("exec").Click ※ここでオブジェクト変数。。。のエラーが発生する※ '表示待ち wait_time = DateAdd("s", 2, Now()) Do While Now() < wait_time DoEvents Loop '表示されたウインドウからデータをセットする Cells(yCNT, 2) = newIE.document.body.innerText '検索の結果をエクセルに反映 '新しいIEを閉じる newIE.Quit Set newIE = Nothing '前のIEを閉じる objIE.Quit Set objIE = Nothing Next yCNT End Sub 初心者なので色々調べたのですがわかりませんでした。。。

  • VBでIEよる新ページ表示後にエラーになる

    VBでIEを操作していますが、ページ表示直後にそのページのソースを処理するステートメントでエラーとなります。デバッグモードのステップインで実行するとエラーにはなりません。尤もページ表示後は、下記処理で表示完了を待つようにしています。 While objIE.ReadyState <> 4 While objIE.Busy = True DoEvents Wend Wend 現在、暫定的に表示完了を待つ処理の後に数秒のインターバルを置くようにしています。何か良い方法はないでしょうか?

  • vb初心者。急いでます!

    修論に取り組む院生です。 vb2010で簡単なソフトを作成中なのですが、以下のようなコードが何度も出てくるため、なんとか短くしたいんです。 型変換や色指定部分の工夫などが考えられると思うのですが、なかなか上手くいかず焦っています。 Dim a213,a214,c212,c213,c214 As Double If a213 < 1 Then ha13.BackColor = Color.FromArgb(160, 140, 255) ElseIf a213 < 20 Then ha13.BackColor = Color.FromArgb(120, 160, 255) ElseIf a213 < 40 Then ha13.BackColor = Color.FromArgb(100, 200, 150) ElseIf a213 < 60 Then ha13.BackColor = Color.FromArgb(255, 255, 70) ElseIf a213 < 80 Then ha13.BackColor = Color.FromArgb(255, 170, 0) Else ha13.BackColor = Color.FromArgb(255, 80, 100) End If If a214 < 1 Then ha14.BackColor = Color.FromArgb(160, 140, 255) ElseIf a214 < 20 Then ha13.BackColor = Color.FromArgb(120, 160, 255) ElseIf a214 < 40 Then ha14.BackColor = Color.FromArgb(100, 200, 150) ElseIf a214 < 60 Then ha14.BackColor = Color.FromArgb(255, 255, 70) ElseIf a214 < 80 Then ha14.BackColor = Color.FromArgb(255, 170, 0) Else ha14.BackColor = Color.FromArgb(255, 80, 100) End If If c212 < 1 Then hc12.BackColor = Color.FromArgb(160, 140, 255) ElseIf c212 < 20 Then hc12.BackColor = Color.FromArgb(120, 160, 255) ElseIf c212 < 40 Then hc12.BackColor = Color.FromArgb(100, 200, 150) ElseIf c212 < 60 Then hc12.BackColor = Color.FromArgb(255, 255, 70) ElseIf c212 < 80 Then hc12.BackColor = Color.FromArgb(255, 170, 0) Else hc12.BackColor = Color.FromArgb(255, 80, 100) End If If c213 < 1 Then hc13.BackColor = Color.FromArgb(160, 140, 255) ElseIf c213 < 20 Then hc13.BackColor = Color.FromArgb(120, 160, 255) ElseIf c213 < 40 Then hc13.BackColor = Color.FromArgb(100, 200, 150) ElseIf c213 < 60 Then hc13.BackColor = Color.FromArgb(255, 255, 70) ElseIf c213 < 80 Then hc13.BackColor = Color.FromArgb(255, 170, 0) Else hc13.BackColor = Color.FromArgb(255, 80, 100) End If If c214 < 1 Then hc14.BackColor = Color.FromArgb(160, 140, 255) ElseIf c214 < 20 Then hc14.BackColor = Color.FromArgb(120, 160, 255) ElseIf c214 < 40 Then hc14.BackColor = Color.FromArgb(100, 200, 150) ElseIf c214 < 60 Then hc14.BackColor = Color.FromArgb(255, 255, 70) ElseIf c214 < 80 Then hc14.BackColor = Color.FromArgb(255, 170, 0) Else hc14.BackColor = Color.FromArgb(255, 80, 100) End If 初めにhが付くものはpicturebox名です。 条件に応じてpictureboxの色を変えるコードで、色は全部で6色で固定です。 このあたりももっと工夫できる気がしてはいるのですが・・・ 時間がないので、とりあえずは期限までに面倒な手順でもソフトを完成させようと思っていますが、さすがに量が多いのでこちらも時間的に危ういです。。 いいアイディアをお持ちの方、よろしくお願いします!!!

  • VB6)「DoEvents」について。(処理を抜けるために?

    どうもこんにちは。よろしくお願いします。 ログイン画面が表示され、IDとパスを入力し、ログインする~画面があるのですが、ログイン後の画面に更新がある場合、ログイン画面に赤い文字で点滅~という処理を行っています。 しかし、その点滅の最中にログインの処理が行われてしまうと、ログイン後の画面は普通に出てくるが、ログイン画面が再び表示されてしまう。ということが。。。 Do NextTime = GetTickCount i = i + 1 If i Mod 2 = 0 Then lblBBS.ForeColor = vbRed j = j + 1 ElseIf i Mod 2 = 1 Then lblBBS.ForeColor = &H8000000F End If '200ミリ秒のウェイト NextTime = NextTime + 400 If i = 10000 Then Exit Do 'i = 0 If NextTime = 10000 Then Exit Do 'NextTime = 0 If j = 5 Then Exit Do Do DoEvents Loop While GetTickCount < NextTime Loop 該当のところは、一番したあたりだと思うのですが、 DoEventsがヘルプを読んでもイマイチどのような物かわからず、どうすればいいのかもわからず。。。 「ログインボタンが押されたらDoExit」みたいな感じで。。。 回避できるでしょうかね??? アドバイスよろしくお願いします。

  • クラス内に自作のイベントを定義したい VB2005

    VB2005を使っています。 クラス内に自作のイベントを定義したいのですがどうすればよいのでしょうか? 非同期のソケットから帰ってきた場合に発生させるイベントです。 System.Net.Sockets.TcpClient System.Net.Sockets.NetworkStream 以下のようにループでなくイベントで処理させたいです。 Do If .DataAvailable Then             ... End If My.Application.DoEvents() Loop

  • VB 繰り返し(ループ)について教えてください

    私は最近プログラムを書く仕事に就いたのですがまったくの初心者でなかなか課題が先に進めずに困っています。もしわかる方いましたら是非教えていただけるとうれしいです。 今わからないのが、繰り返し(ループ)です。 何とか一桁目は完成しましたがこの先がどうやってもうまくいきません。左にTextBox、真ん中にCommand、左にLabelがあり左に整数を入れて真ん中を押すと左に漢数字で表示されるという形で5桁まで出来るようにしたいのです。 今出来ているものをとりあえずはりますので是非教えてください。 Option Explicit Private Sub Command1_Click() Dim a As Integer Dim b As String a = Val(Text1.Text) If a = 0 Then b = "0" ElseIf a = 1 Then b = "一" ElseIf a = 2 Then b = "二" ElseIf a = 3 Then b = "三" ElseIf a = 4 Then b = "四" ElseIf a = 5 Then b = "五" ElseIf a = 6 Then b = "六" ElseIf a = 7 Then b = "七" ElseIf a = 8 Then b = "八" Else b = "九" Label1.Caption = b End Sub

  • ファイルを読み込んだらVBがフリーズする

    ↓のコードだと、ファイルを読み込んだ時点でVBがフリーズします(平気なファイルも一部ある)。原因と解決法を教えてください。 Private Sub Command1_Click() CommonDialog1.Filter = "テキスト(*.txt)|*.txt|すべて(*.*)|*.*" CommonDialog1.FilterIndex = 1 CommonDialog1.Flags = cdlONFileMustExist CommonDialog1.CancelError = True On Error Resume Next CommonDialog1.ShowOpen If (Err = 0) Then FileRead CommonDialog1.FileName End If On Error GoTo 0 End Sub Private Sub FileRead(FL As String) Dim FileNo As Integer Dim strDAT As String Dim strELM As String Dim pot1 As Integer, pot2 As Integer Dim pDB1 As Integer, pDB2 As Integer FileNo = FreeFile() Open FL For Input As #FileNo While Not EOF(FileNo) Line Input #FileNo, strDAT strDAT = strDAT & ":" pot1 = InStr(strDAT, ":") While pot1 > 0 strELM = Left(strDAT, pot1) pot2 = InStr(strELM, "OPEN") While pot2 > 0 pDB1 = InStr(strELM, Chr(&H22)) If pDB1 > 0 Then '前の『"』の位置 pDB2 = InStr(pDB1 + 1, strELM, Chr(&H22)) If pDB2 > 0 Then RichTextBox1.Text = RichTextBox1.Text & _ Mid(strELM, pDB1 + 1, pDB2 - pDB1 - 1) & vbCrLf End If End If pot2 = InStr(pDB2 + 1, strELM, "OPEN") Wend strDAT = Mid(strDAT, pot1 + 1) pot1 = InStr(strDAT, ":") Wend Wend Close #FileNo End Sub

  • エクセルVBAでセルのクリックイベントについて

    エクセルのVBAでDo Whileループの中で,いずれかのセルがクリック され(アクティブ)になったことを知る方法が分かりません。 調べたいセルの個数は数十個で,セルのクリックを連続的に行い, その度に,ある操作を行いたいのです。 Do while flag=true   if ActiveCell.Address="A1" then ****   if ActiveCell.Address="A2" then ****   if ActiveCell.Address="A3" then ****   (これをいくつか記述)   (ループから抜け出る記述) loop これだと,無限ループに陥ってしまいます。 どなたか,お知恵をお貸しください。

専門家に質問してみよう