EXCEL登録スクリプト

EXCELに登録するシーンというのが意外と多いので


VBScriptでTry,Catch使える方法がないかなぁと。
へっぽこプログラマーなのでエラー処理が多過ぎて、苦痛でした。

まぁスクリプトと割り切ってエラー制御端折るのも手だけどなぁ。
エラー処理は日々是勉強ですな。


Function ExcelSheetInput(val_keyNo,val_Clumn,val_Path)
    '参照:http://3rd.geocities.jp/kaito_extra/Source/ExcelCtrl.html
    Dim argRtn(3)        '引数チェック用   
    Dim objExcel
    Dim xlSheet
    Dim keyNO            '
    Dim InputDate        '
    Dim Clumn            '
    Dim excelPath        '
    Dim i            'ループカウンター
    Dim LastRow            'EXCEL最終行
    Dim matchnum        '対象EXCEL行数確保用
    Dim KeyCell            'Key保管EXCEL行
    Dim CellValue        'Key格納用ワーク
    Dim InputArea        '更新行
    Dim strEmpCol   
    strEmpCol ="X"         'EXCELの列
    Dim objFso            'ファイル存在チェック用

    '/* 引数エラーチェック
    argRtn(0)= argumentChecker(val_keyNo)
    argRtn(1)= argumentChecker(val_Clumn)
    argRtn(2)= argumentChecker(val_Path)
   
    If argRtn(0) ="False" Or argRtn(1) ="False" Or argRtn(2)="False" Then
        ExcelSheetInput = "False"
        Logrtn = OutLogger("[Err],EXCELパスが入力されていません。")
        If Logrtn = "False" Then
            WScript.Echo LErrMsg
        End If
        Exit Function
    Else
        keyNO = val_keyNo
        InputDate = Mid(Now(),6,5) & "XX"    '処理完了登録用
        Clumn = val_Clumn
        excelPath = val_Path
    End If
   
    'ファイル存在チェック
    Set objFso = CreateObject("Scripting.FileSystemObject")
    If objFso.FileExists(excelPath) Then
        Set objExcel = CreateObject("Excel.Application")
        objExcel.Workbooks.Open(excelPath)
        Set xlSheet = objExcel.Worksheets(1)
        objExcel.Visible = False
    Else
        ExcelSheetInput="False"
        Logrtn = OutLogger("[Err],EXCELファイルが存在しません。")
        If Logrtn = "False" Then
            WScript.Echo LErrMsg
        End If
        Exit Function
    End If
   
    LastRow = xlSheet.UsedRange.Rows.Count        'EXCEL最終行取得
   
    For i = 1 To LastRow Step 1
        'KeyNoと比較してヒットするものの行数を取得
        KeyCell = strEmpCol & i
        CellValue = xlSheet.Range(KeyCell).Value
       
        If keyNO = CellValue Then
            matchnum = i
            Exit For
        End If
    Next
   
    If keyNO <> CellValue Then
        objExcel.DisplayAlerts = False
        objExcel.Application.Quit       
        ExcelSheetInput="False"
        Exit Function
    End If
   
    'セットする。
    InputArea = Clumn & matchnum
    xlSheet.Range(InputArea).Value = InputDate
    'EXCELを保存して終了
    objExcel.DisplayAlerts = False
    objExcel.Workbooks(1).Save
    objExcel.Application.Quit       
    ExcelSheetInput ="True"
End Function

コメント

このブログの人気の投稿

証券外務員1種勉強(計算式暗記用メモ)

GASでGoogleDriveのサブフォルダとファイル一覧を出力する

マクロ経済学(IS-LM分析)