データロガーWebから定期的にダウンロード保存する（備忘録）

chatGPT先生に教えていただいて、Execlのマクロを使って、データロガーのｗｅｂページから
データを定期的にダウンロードしてローカルドライブに保存するシートを作りました。
改善の余地はたくさんありますが・・・まあ、伸びしろがあるということですね。

前提条件
ネットワーク内に、CSV形式ファイルデータが保存されたHTTPサーバが動作しています。
データを表示するURLは”http://IPアドレス/年月日.CSV”（ファイル名例20231216.csv）です。

仕様
・マクロの実行、停止はExcelシートのボタンクリックで操作します。
・IPアドレス、保存先のローカルドライブのパス、ダウンロード保存を実行するインターバル時間を
ユーザーフォームで設定します。
・マクロを実行した日のファイルをダウンロードします。
・ダウンロードファイルの保存ファイル名（ブック名）シート名は当日の年月日とします。
・ローカルドライブパスへ当日ファイルを作成し保存します。インターバル時間毎にファイルを更新します。

既知の問題点
マクロ停止操作で”xxxエラー”が出ます。
再度マクロを実行するときは”リセット”ボタンをクリックしてから”マクロの実行”操作してください。

シートのデザインは必要最小限です。

使っていない部分もありますが、今後のことも考えてあえて残しています。

Public startDate As Date, dateValue As Date, localPath As String, csvURL As String, intervalMinutes As Integer, IPAddress As String

'ユーザーフォームを表示するメインのサブルーチン
Sub FormShow()
    ' ユーザーフォームを表示
    frmSetUp.Show
End Sub
Sub mainProgram()
Dim response As VbMsgBoxResult

'実行確認のダイアログを表示
response = MsgBox("メインプログラムを実行します。よろしいですか？", vbYesNo + vbQuestion, "確認")

'ユーザーが「はい」をクリックした場合
If response = vbYes Then
'メインプログラムの処理を開始
'Call downloadAndSave
Call FormShow
Else
'ユーザーが「いいえ」をクリックした場合
MsgBox "メインプログラムの実行をキャンセルしました。", vbInformation, "情報"
End If
End Sub
'!!注意!!サブルーチン名と処理内容が違う ダウンロードの開始日を当日日付に設定する。ダウンロードするCSVファイルのURLを生成する。
Sub downloadAndSave()

<code>' 改善が必要な点 過去のデータをダウンロードすることができない
' サブルーチン関連性 ブック、シートの作成、ファイル名の生成で個別に当日日付を取得しているので、
' 過去の日付が使えるようにそれぞれで改変が必要になる。
' インターフェースの改変　ユーザーフォームに入力された日付を取得し変数へ代入
    </code>
<code>    'Dim startDate As Date ' ダウンロードの開始日？←←
    'Dim localPath As String ' ローカルファイルの保存先パス
    'Dim csvURL As String ' csvファイルのURL
</code>    
<code>    ' 開始日を設定（使っていません。）
    ' startDate = DateSerial(2023, 11, 1) ' 開始日を適切な日付に変更←←
    startDate = Format(Date, "YYYY,MM,DD") ' 開始日を当日日付にセット←←
    </code>
   <code> ' ローカルファイルの保存先パスを設定
    'localPath = "E:" 'フォームから設定するように変更予定</code>

<code>    ' ダウンロードするCSVファイルのURLを設定 URL構文はブラウザ入力と同じです。
    'csvURL = "http://192.168.2.254/ Format(Date, "YYYYMMDD") & ".csv" '変更前のコード←←←←
    csvURL = "http://" & IPAddress & "/" & Format(Date, "YYYYMMDD") & ".csv" 'フォーム設定へ 当日の日付を取得してファイル名に使う←←←←
    MsgBox "CSVファイルのURLは：" & csvURL, vbInformation, "変数の確認" 'デバック用
    'Call DownloadAndContinue '繰り返しダウンロード、Continueを呼び出す。2023.12.08変更前
    Call StartDownload '2023.12.08
End Sub
'ダウンロードを開始するサブルーチン2023.12.08
Sub StartDownload()
'MsgBox "StartDownload確認" ' デバック用
'定期的にダウンロードを開始</code>

<code>    'MsgBox "IP Addressは：" & IPAddress, vbInformation, "変数の確認" 'デバック用
    'MsgBox "保存先パスは：" & localPath, vbInformation, "変数の確認" 'デバック用
    'MsgBox "インターバルは：" & intervalMinutes, vbInformation, "変数の確認" 'デバック用</code>

<code>Application.OnTime Now + TimeSerial(0, intervalMinutes, 0), "DownloadData"
'MsgBox "StartDownloadサブルーチン実行完了" ' デバック用
End Sub</code>

<code>'CSVデータのダウンロードと処理を行うサブルーチン2023.12.08
Sub DownloadData()</code>

<code>'MsgBox "DownloadData実行前" ' デバック用
'ここにcsvデータをダウンロードしてローカルに保存するコードを実装
'サブルーチン"SaveExcel"をここへ挿入する。</code>

<code>'csvファイルをダウンロードして保存するサブルーチン2023.12.08 サブルーチン"SaveExcel"を挿入
'カンマ区切り文字としてインポートする。当日年月日をファイル名にする。指定先にExcel形式で保存する。
'Sub SaveExcel(csvURL As String, localPath As String, dateValue As Date)←←←
'DimはVBAで変数を宣言するキーワードです 変数名とデータ型を指定します
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim fileName As String
    Dim previousPathFileName As String
    Dim previousFileName As String
    Dim chekFileName As String
    </code>
<code>    ' 既存のブックが開かれているか確認
    On Error Resume Next
    ' On Error Resume Next:実行時エラーが発生してもマクロＶＢＡを中断せずにエラーが発生した
    'ステートメントの次ステートメントから実行を継続 …オートメーションエラーなどの原因になる可能性有り
    </code>
<code>    'csvURL = "http://192.168.2.254/ Format(Date, "YYYYMMDD") & ".csv" '参考用←←←←
    '開かれていると想定されるブック（ファイル）名を当日の日付から生成します。
    checkFileName = Format(Date, "YYYYMMDD") & ".xlsx" 'dateValueをDateへ変更←←←←
    'Set wb = Workbooks(Format(Date, "YYYYMMDD") & ".xlsx") 'このように書くとエラーになる←←←←
    </code>
<code>    Set wb = Workbooks("checkFileName") '…Setでwbという変数に入れる
    ' "Workbooks("checkFileName")"Workbookオブジェクトを参照 複数のブックを開いている時に、
    '"checkFileName"で指定したブックをアクティブにします。開いてある必要があります(無いとエラー)
    On Error GoTo 0
    'On Error GoTo 0:現在のプロシージャですべての有効なエラー処理ルーチンを無効にします｡
    </code>
<code>    '複数のブック･･･マクロの入ったブックとデータの入ったブックが(別のフォルダに)存在することになる。
    'ダウンロードしたデータはマクロを書いたブックには保存しないで、
    '日付をファイル名としたExcelファイルに保存します。
    </code>
<code>    ' 既存のブックがない場合、新しいブックを作成
    If wb Is Nothing Then
        Set wb = Workbooks.Add '…Setでwbという変数に入れる
    End If
    </code>
<code>    ' 既存のシートがあるか確認
    On Error Resume Next '実行時エラーが発生しても･･･次ステートメントから実行
    'シート名を当日の日付から生成し、ます。
    Set ws = wb.Sheets(Format(Date, "YYYYMMDD")) '…Setでwsという変数に入れる←←←←
    On Error GoTo 0 'エラー処理ルーチンを無効にします｡
    </code>
<code>    ' 既存のシートがない場合、新しいシートを作成
    If ws Is Nothing Then
        Set ws = wb.Sheets.Add
        ws.Name = Format(Date, "YYYYMMDD") '←←←←
    End If
    </code>
<code>    ' ファイル名を作成（年月日を使用）fileName = localPath & Format(Date, "YYYYMMDD") & ".xlsx"'←←←←
    ' シートの名前を設定（年月日を使用）ws.Name = Format(Date, "YYYYMMDD")'←←←←
   </code>
<code>    ' 新しいブックを作成  Set wb = Workbooks.Open "fileName" ' エラーとなっていた
    ' Set ws = wb.Sheets(1) ' 指定したブック('wb')から最初のシートを取得して'ws'に割り当てる
    ' シートの名前を設定（年月日を使用）' ws.Name = Format(Date, "YYYYMMDD")'←←←←</code>

<code>    ' テキストのインポート（カンマを区切り文字として指定）
    With ws.QueryTables.Add(Connection:="TEXT;" & csvURL, Destination:=ws.Range("A1"))
        .TextFileParseType = xlDelimited
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileCommaDelimiter = True  ' カンマを区切り文字として指定
        .Refresh
    End With</code>

<code>    ' ファイル名を作成（年月日を使用）
    fileName = localPath & Format(Date, "YYYYMMDD") & ".xlsx" '←←←←
    </code>
<code>    'MsgBox "保存ファイル名は：" & fileName, vbInformation, "確認" 'デバック用
    </code>
<code>    ' 保存
    Application.DisplayAlerts = False ' True:警告メッセージ表示 False:非表示
    wb.SaveAs fileName, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True 'False ' True:警告メッセージ表示 False:非表示</code>

<code>    ' 既存のブックを閉じる
    wb.Close SaveChanges:=False ' False:内容の変更は保存しない 前の"wb.SaveAs"で保存されているためと思う
    </code>
<code>    ''previousFileName = Format(Date - 1, "YYYYMMDD") & ".xlsx"'←←←←</code>

<code>    ' 前日のファイルが開かれているか確認
    ''On Error Resume Next
    ' Set wb = Workbooks(Format(Date - 1, "YYYYMMDD") & ".xlsx")'←←←←
    ''Set wb = Workbooks("previousFileName")
    ''On Error GoTo 0</code>

<code>    ' 前日のファイルが開かれている場合、保存して閉じる
    ''If Not wb Is Nothing Then
        ''Application.DisplayAlerts = True ' True:警告メッセージ表示 False:非表示
        </code>
<code>        ''previousPathFileName = localPath & Format(Date - 1, "YYYYMMDD") & ".xlsx"'←←←←
        ''wb.SaveAs previousPathFileName, FileFormat:=xlOpenXMLWorkbook ' ブックを保存
        ''wb.Close SaveChanges:=False 'False:変更があっても保存せずに終了 True:保存して終了
        </code>
<code>        ''Application.DisplayAlerts = True 'False ' True:警告メッセージ表示 False:非表示
    ''End If</code>

<code>    ' ファイル名を作成（年月日を使用）' fileName = localPath & Format(Date, "YYYYMMDD") & ".xlsx"'←←←←
    ' Excelファイルを保存 'wb.SaveAs fileName, FileFormat:=xlOpenXMLWorkbook
    ' ブックを閉じる ' wb.Close SaveChanges:=False
    </code>
<code>    'Call DownloadAndContinue
'End Sub</code>

<code>' Sub ContinueProcessing()
' Call DownloadAndContinue
' End Sub</code>

<code>'ダウンロード完了後、次のダウンロードをスケジュール
StartDownload
End Sub</code>

<code>'ダウンロードを停止するサブルーチン 2023.12.08 ' Execlシートのボタンからこのサブルーチンを呼び出しています。2023.12.11
Sub StopDownload()</code>

<code>'タイマーのスケジュールをキャンセル
On Error Resume Next
Application.OnTime NextExecution:=Now, Procedure:="DownloadData", Schedule:=False
On Error GoTo 0
End Sub</code>

<code>'設定したキーが押されたことを検出しStopDownloadサブルーチンを呼び出す。使っていません2023.12.10
Sub DetectKeyPress() 'サブルーチンを呼び出す方法の例として残しています</code>

<code>    'ctrl+shift+右方向キーが押されるとStopDownloadサブルーチン(プロシージャ)が呼ばれるように設定
    Application.OnKey "^+{RIGHT}", "StopDownload"</code>

<code>End Sub</code> 

ユーザーフォームのデザイン

ユーザーフォームのコード

'フォームのテキストボックスに入力された内容を"設定を反映する"ボタンクリックで変数へ代入します。
Private Sub buttonSaveValue_Click()

'!!注意!!入力が正しいか間違っているかチェックをしていません。
' インターフェースの改変　ユーザーフォームに入力された日付を取得し変数へ代入

<code>MsgBox "保存先はWindows起動ドライブ（C:）以外を設定してください。エラーになる可能性あります。"
    IPAddress = frmSetUp.TextBox1.Value 'フォーム(frmSetUp)のTextBox1に入力されたIPアドレスを"IPAddress"へ代入します。
    localPath = frmSetUp.TextBox2.Value '…TextBox2に入力された保存先パスを"localPath"へ代入
    intervalMinutes = CInt(frmSetUp.TextBox3.Value) '…TextBox3に入力されたインターバル(分)を"intervalMinutes"へ代入
    'CInt()は引数をIntegerデータ型に変換します。</code>

<code>    MsgBox "IP Addressは：" & IPAddress, vbInformation, "変数の確認" 'デバック用
    MsgBox "保存先パスは：" & localPath, vbInformation, "変数の確認" 'デバック用
    MsgBox "インターバルは：" & intervalMinutes, vbInformation, "変数の確認" 'デバック用
    </code>
<code>Call downloadAndSave</code>

<code>frmSetUp.Hide</code>

<code>End Sub</code>

chatGPT先生ありがとうございました。
おかげでスキルアップできました。