WEB_U マクロ化
- depth:
- 0
前の投稿
-
次の投稿
|
親投稿
-
子投稿なし
|
投稿日時 2010-2-28 23:21
ゲスト
投稿数: 0
'モジュールレベル変数宣言
Private FREE_NUMBER As Long
Private LOG_FOLDER As String
Private LOG_FILE As String
Private LOG_FILENAME As String
Sub FUND0004()
'☆変数宣言開始--------------------------------------------------------------------------------------
'パス変数宣言
Dim MAIN_PATH As String
'フォルダ変数宣言
Dim WEB_FOLDER As String
'シート変数宣言
Dim KIDO_SH As String
Dim HANTEI_SH As String
Dim WEB_DATA_SH As String
'ファイル変数宣言
Dim WEB_FILE As String
Dim WEB_FILENAME As String
'メッセージ変数
Dim INIT_MSG As String
Dim FILE_DOWNLORD_MSG As String
Dim OK_DATE_MSG As String
Dim NG_DATE_MSG As String
Dim OK_COUNT_MSG As String
Dim NG_COUNT_MSG As String
Dim OK_MSG As String
Dim NG_MSG As String
'オブジェクト変数宣言
Dim FSO As Object
Dim Sht As Object
Dim TODAY_DATE_CELL As Object
Dim TODAY_DATE_1BEFORE_CELL As Object
Dim TODAY_UP_DATE_CELL As Object
Dim TODAY_UP_COUNT_CELL As Object
Dim TODAY_UP_COUNT_1BEFORE_CELL As Object
Dim 検索セル As String
Dim 対象セル As String
'カウント変数宣言
Dim TODAY_UP_COUNT_LEN As Integer
Dim TODAY_UP_COUNT_1BEFORE_LEN As Integer
Dim TODAY_UP_COUNT_LEFT As Integer
Dim TODAY_UP_COUNT_1BEFORE_LEFT As Integer
Dim CNT As Integer
'☆変数宣言終了--------------------------------------------------------------------------------------
'☆変数設定開始--------------------------------------------------------------------------------------
'日付変数設定
YYYY = CStr(Format(Date, "yyyy"))
MM = CStr(Format(Date, "m"))
DD = CStr(Format(Date, "dd"))
TODAY_DATE = YYYY & "/" & MM & "/" & DD
'パス変数設定
MAIN_PATH = ThisWorkbook.Path
'フォルダ変数設定
WEB_FOLDER = "D:\WEB\WEB"
LOG_FOLDER = "D:\WEB\LOG"
'シート変数設定
KIDO_SH = "起動シート"
HANTEI_SH = "WEB_DATA判定シート"
WEB_DATA_SH = "日本"
'ファイル変数設定
MAIN_FILE = "日付確認マクロ.xlsm"
MAIN_FILENAME = MAIN_PATH & "\" & MAIN_FILE
WEB_FILE = "fund0004.xls"
WEB_FILENAME = WEB_FOLDER & "\" & WEB_FILE
LOG_FILE = "FUND0004_LOG.TXT"
LOG_FILENAME = LOG_FOLDER & "\" & LOG_FILE
'メッセージ変数設定
INIT_MSG = "シートの初期化が完了致しました。"
FILE_DOWNLORD_MSG = "WEBファイルの取込が完了致しました。"
OK_DATA_MSG = "本日分の更新日が更新されております。"
NG_DATA_MSG = "本日分の更新日が更新されておりません。"
OK_COUNT_MSG = "本日分は想定内の件数で更新されています。"
NG_COUNT_MSG = "本日分は想定外の件数で更新されています。"
OK_MSG = "正常終了"
NG_MSG = "異常終了"
'オブジェクト変数設定
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TODAY_DATE_CELL = Worksheets(HANTEI_SH).Range("B3")
Set TODAY_DATE_1BEFORE_CELL = Worksheets(HANTEI_SH).Range("C3")
Set TODAY_UP_DATE_CELL = Worksheets(WEB_DATA_SH).Range("A2")
Set TODAY_UP_COUNT_CELL = Worksheets(WEB_DATA_SH).Range("B2")
Set TODAY_UP_COUNT_1BEFORE_CELL = Worksheets(WEB_DATA_SH).Range("B3")
'関数設定
FREE_NUMBER = FreeFile
'☆変数設定終了--------------------------------------------------------------------------------------
'☆処理開始--------------------------------------------------------------------------------------
'初期化処理
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Worksheets(WEB_DATA_SH).Select
Application.Cells.ClearContents
Call HANTEI("初期化結果出力処理", INIT_MSG)
'ファイル取込処理
Workbooks.Open (WEB_FILENAME)
Workbooks(WEB_FILE).Worksheets(WEB_DATA_SH).Range("A1:B3").Copy Destination:=Workbooks(MAIN_FILE).Worksheets(WEB_DATA_SH).Range("A1")
Workbooks(WEB_FILE).Activate
ActiveWorkbook.Close
Workbooks(MAIN_FILE).Activate
Worksheets(KIDO_SH).Select
Call HANTEI("ファイル取込結果出力処理", FILE_DOWNLORD_MSG)
'更新分日付生成処理
TODAY_DATE_CELL = TODAY_DATE
Call HANTEI("更新分日付生成結果出力処理", TODAY_DATE_1BEFORE_CELL)
'本日分反映確認処理
If TODAY_DATE_1BEFORE_CELL = TODAY_UP_DATE_CELL Then
Call HANTEI("本日分反映確認結果出力処理", OK_DATA_MSG)
TODAY_UP_COUNT_LEN = Len(TODAY_UP_COUNT_CELL)
TODAY_UP_COUNT_1BEFORE_LEN = Len(TODAY_UP_COUNT_1BEFORE_CELL)
TODAY_UP_COUNT_LEFT = Left(TODAY_UP_COUNT_CELL, 1)
TODAY_UP_COUNT_1BEFORE_LEFT = Left(TODAY_UP_COUNT_1BEFORE_CELL, 1)
If TODAY_UP_COUNT_LEN = TODAY_UP_COUNT_1BEFORE_LEN Then
If TODAY_UP_COUNT_LEFT = TODAY_UP_COUNT_1BEFORE_LEFT Then
Call HANTEI("本日分反映確認結果出力処理", OK_COUNT_MSG)
Call HANTEI("判定結果出力処理", OK_MSG)
Else
CNT = TODAY_UP_COUNT_LEFT - TODAY_UP_COUNT_1BEFORE_LEFT
If CNT < 2 And CNT > -2 Then
Call HANTEI("本日分反映確認結果出力処理", OK_COUNT_MSG)
Call HANTEI("判定結果出力処理", OK_MSG)
Else
Call HANTEI("本日分反映確認結果出力処理", NG_COUNT_MSG)
Call HANTEI("判定結果出力処理", NG_MSG)
End If
End If
Else
Call HANTEI("本日分反映確認結果出力処理", NG_COUNT_MSG)
Call HANTEI("判定結果出力処理", NG_MSG)
End If
Else
Call HANTEI("本日分反映確認結果出力処理", NG_DATA_MSG)
Call HANTEI("判定結果出力処理", NG_MSG)
End If
End Sub
Function HANTEI(LINE_MSG, KEKKA_MSG) As String
Open LOG_FILENAME For Append As #FREE_NUMBER
Print #FREE_NUMBER, "=========================" & LINE_MSG & "開始========================="
Print #FREE_NUMBER, WriteBlankLines
Print #FREE_NUMBER, KEKKA_MSG
Print #FREE_NUMBER, WriteBlankLines
Print #FREE_NUMBER, "=========================" & LINE_MSG & "終了========================="
Print #FREE_NUMBER, WriteBlankLines
Close #FREE_NUMBER
End Function
Function TIME(LINE_MSG, KEKKA_MSG) As String
HH = Hour(Now)
MM2 = Minute(Now)
SS = Second(Now)
PRIME_TIME = HH & ":" & MM2 & ":" & SS
Open LOG_FILENAME For Append As #FREE_NUMBER
Print #FREE_NUMBER, "=========================" & LINE_MSG & "開始========================="
Print #FREE_NUMBER, WriteBlankLines
Close #FREE_NUMBER
End Function
Private FREE_NUMBER As Long
Private LOG_FOLDER As String
Private LOG_FILE As String
Private LOG_FILENAME As String
Sub FUND0004()
'☆変数宣言開始--------------------------------------------------------------------------------------
'パス変数宣言
Dim MAIN_PATH As String
'フォルダ変数宣言
Dim WEB_FOLDER As String
'シート変数宣言
Dim KIDO_SH As String
Dim HANTEI_SH As String
Dim WEB_DATA_SH As String
'ファイル変数宣言
Dim WEB_FILE As String
Dim WEB_FILENAME As String
'メッセージ変数
Dim INIT_MSG As String
Dim FILE_DOWNLORD_MSG As String
Dim OK_DATE_MSG As String
Dim NG_DATE_MSG As String
Dim OK_COUNT_MSG As String
Dim NG_COUNT_MSG As String
Dim OK_MSG As String
Dim NG_MSG As String
'オブジェクト変数宣言
Dim FSO As Object
Dim Sht As Object
Dim TODAY_DATE_CELL As Object
Dim TODAY_DATE_1BEFORE_CELL As Object
Dim TODAY_UP_DATE_CELL As Object
Dim TODAY_UP_COUNT_CELL As Object
Dim TODAY_UP_COUNT_1BEFORE_CELL As Object
Dim 検索セル As String
Dim 対象セル As String
'カウント変数宣言
Dim TODAY_UP_COUNT_LEN As Integer
Dim TODAY_UP_COUNT_1BEFORE_LEN As Integer
Dim TODAY_UP_COUNT_LEFT As Integer
Dim TODAY_UP_COUNT_1BEFORE_LEFT As Integer
Dim CNT As Integer
'☆変数宣言終了--------------------------------------------------------------------------------------
'☆変数設定開始--------------------------------------------------------------------------------------
'日付変数設定
YYYY = CStr(Format(Date, "yyyy"))
MM = CStr(Format(Date, "m"))
DD = CStr(Format(Date, "dd"))
TODAY_DATE = YYYY & "/" & MM & "/" & DD
'パス変数設定
MAIN_PATH = ThisWorkbook.Path
'フォルダ変数設定
WEB_FOLDER = "D:\WEB\WEB"
LOG_FOLDER = "D:\WEB\LOG"
'シート変数設定
KIDO_SH = "起動シート"
HANTEI_SH = "WEB_DATA判定シート"
WEB_DATA_SH = "日本"
'ファイル変数設定
MAIN_FILE = "日付確認マクロ.xlsm"
MAIN_FILENAME = MAIN_PATH & "\" & MAIN_FILE
WEB_FILE = "fund0004.xls"
WEB_FILENAME = WEB_FOLDER & "\" & WEB_FILE
LOG_FILE = "FUND0004_LOG.TXT"
LOG_FILENAME = LOG_FOLDER & "\" & LOG_FILE
'メッセージ変数設定
INIT_MSG = "シートの初期化が完了致しました。"
FILE_DOWNLORD_MSG = "WEBファイルの取込が完了致しました。"
OK_DATA_MSG = "本日分の更新日が更新されております。"
NG_DATA_MSG = "本日分の更新日が更新されておりません。"
OK_COUNT_MSG = "本日分は想定内の件数で更新されています。"
NG_COUNT_MSG = "本日分は想定外の件数で更新されています。"
OK_MSG = "正常終了"
NG_MSG = "異常終了"
'オブジェクト変数設定
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TODAY_DATE_CELL = Worksheets(HANTEI_SH).Range("B3")
Set TODAY_DATE_1BEFORE_CELL = Worksheets(HANTEI_SH).Range("C3")
Set TODAY_UP_DATE_CELL = Worksheets(WEB_DATA_SH).Range("A2")
Set TODAY_UP_COUNT_CELL = Worksheets(WEB_DATA_SH).Range("B2")
Set TODAY_UP_COUNT_1BEFORE_CELL = Worksheets(WEB_DATA_SH).Range("B3")
'関数設定
FREE_NUMBER = FreeFile
'☆変数設定終了--------------------------------------------------------------------------------------
'☆処理開始--------------------------------------------------------------------------------------
'初期化処理
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Worksheets(WEB_DATA_SH).Select
Application.Cells.ClearContents
Call HANTEI("初期化結果出力処理", INIT_MSG)
'ファイル取込処理
Workbooks.Open (WEB_FILENAME)
Workbooks(WEB_FILE).Worksheets(WEB_DATA_SH).Range("A1:B3").Copy Destination:=Workbooks(MAIN_FILE).Worksheets(WEB_DATA_SH).Range("A1")
Workbooks(WEB_FILE).Activate
ActiveWorkbook.Close
Workbooks(MAIN_FILE).Activate
Worksheets(KIDO_SH).Select
Call HANTEI("ファイル取込結果出力処理", FILE_DOWNLORD_MSG)
'更新分日付生成処理
TODAY_DATE_CELL = TODAY_DATE
Call HANTEI("更新分日付生成結果出力処理", TODAY_DATE_1BEFORE_CELL)
'本日分反映確認処理
If TODAY_DATE_1BEFORE_CELL = TODAY_UP_DATE_CELL Then
Call HANTEI("本日分反映確認結果出力処理", OK_DATA_MSG)
TODAY_UP_COUNT_LEN = Len(TODAY_UP_COUNT_CELL)
TODAY_UP_COUNT_1BEFORE_LEN = Len(TODAY_UP_COUNT_1BEFORE_CELL)
TODAY_UP_COUNT_LEFT = Left(TODAY_UP_COUNT_CELL, 1)
TODAY_UP_COUNT_1BEFORE_LEFT = Left(TODAY_UP_COUNT_1BEFORE_CELL, 1)
If TODAY_UP_COUNT_LEN = TODAY_UP_COUNT_1BEFORE_LEN Then
If TODAY_UP_COUNT_LEFT = TODAY_UP_COUNT_1BEFORE_LEFT Then
Call HANTEI("本日分反映確認結果出力処理", OK_COUNT_MSG)
Call HANTEI("判定結果出力処理", OK_MSG)
Else
CNT = TODAY_UP_COUNT_LEFT - TODAY_UP_COUNT_1BEFORE_LEFT
If CNT < 2 And CNT > -2 Then
Call HANTEI("本日分反映確認結果出力処理", OK_COUNT_MSG)
Call HANTEI("判定結果出力処理", OK_MSG)
Else
Call HANTEI("本日分反映確認結果出力処理", NG_COUNT_MSG)
Call HANTEI("判定結果出力処理", NG_MSG)
End If
End If
Else
Call HANTEI("本日分反映確認結果出力処理", NG_COUNT_MSG)
Call HANTEI("判定結果出力処理", NG_MSG)
End If
Else
Call HANTEI("本日分反映確認結果出力処理", NG_DATA_MSG)
Call HANTEI("判定結果出力処理", NG_MSG)
End If
End Sub
Function HANTEI(LINE_MSG, KEKKA_MSG) As String
Open LOG_FILENAME For Append As #FREE_NUMBER
Print #FREE_NUMBER, "=========================" & LINE_MSG & "開始========================="
Print #FREE_NUMBER, WriteBlankLines
Print #FREE_NUMBER, KEKKA_MSG
Print #FREE_NUMBER, WriteBlankLines
Print #FREE_NUMBER, "=========================" & LINE_MSG & "終了========================="
Print #FREE_NUMBER, WriteBlankLines
Close #FREE_NUMBER
End Function
Function TIME(LINE_MSG, KEKKA_MSG) As String
HH = Hour(Now)
MM2 = Minute(Now)
SS = Second(Now)
PRIME_TIME = HH & ":" & MM2 & ":" & SS
Open LOG_FILENAME For Append As #FREE_NUMBER
Print #FREE_NUMBER, "=========================" & LINE_MSG & "開始========================="
Print #FREE_NUMBER, WriteBlankLines
Close #FREE_NUMBER
End Function
投票数:70
平均点:4.29
返信する
この投稿に返信する
投稿ツリー
-
WEB_U マクロ化 (ゲスト, 2010-2-28 23:21)