Access VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


1982 / 9994 ←次へ | 前へ→

【11292】Re:コマンドボタンを押下すると、指定ファルダ下にあるtxtをインポートしたい。
発言  小僧  - 09/12/11(金) 15:23 -

引用なし
パスワード
   ▼cocoa さん:
こんにちは。
まずは解決されまして何よりです。

> -------------------------------------------------------------------------
> ホスト 'ServerName' の 'application' ログのイベントを一覧表示しています。
> -------------------------------------------------------------------------

この情報が早く欲しかったです(笑)

初めてApplicationログをCSVに落とすプログラムを組んでみましたが
Description内 に改行コードがあると
CSVの体裁が崩れてしまったり、
また先頭行と最終行に半角のスペースがあったりと
何か変な仕様なのですね。

cocoa さんの環境ですと Description が

> 内容が、0____userName(_は半角スペース)です。

という事なので、
バッチファイルで何か特殊なアプリケーションのみ
ログを抽出しているという事なのでしょうかね。


Public Function AppLogInsert(Optional ServerName As String _
              , Optional UserName As String _
              , Optional PassWord As String _
              , Optional TargetDate As Date) As Boolean
         
Const strFilePath = "C:\applog.log"

Dim strCommand As String
Dim Con As New ADODB.Connection
Dim Rec As New ADODB.Recordset
Dim txtData As String
Dim FNo As Long
Dim Cnt As Long
Dim CommitFLG As Boolean

  On Error Resume Next
    Kill strFilePath
  On Error GoTo 0
 
  strCommand = ""
 
  If ServerName = "" Then
    strCommand = strCommand & " -S localhost "
  Else
    strCommand = strCommand & " -S " & ServerName & " "
  End If
 
  If UserName <> "" Then
    strCommand = strCommand & " -U " & UserName & " "
  End If

  If PassWord <> "" Then
    strCommand = strCommand & " -P " & PassWord & " "
  End If
 
  If TargetDate = 0 Then
    TargetDate = Date
  End If
 
  strCommand = strCommand & " /fi ""DateTime eq " _
        & Format(TargetDate - 1, "mm/dd/yyyy") & ",12:00:00PM-" _
        & Format(TargetDate, "mm/dd/yyyy") & ",11:59:59PM"""
  
  strCommand = " cscript //nologo " _
        & "%systemroot%\system32\eventquery.vbs " _
        & " -v /l application -fo list" _
        & strCommand & " > " & strFilePath

  CreateObject("WScript.Shell").Run "%ComSpec% /c " & strCommand, 0, True

  Set Con = CurrentProject.Connection
 
  If DCount("*", "MsysObjects", "Name ='T_ApplicationLog'") = 0 Then
    Con.Execute CreateTableApplog
  Else
    Con.Execute "DELETE FROM T_ApplicationLog"
  End If
  
  Rec.Open "T_ApplicationLog", Con, adOpenDynamic, adLockOptimistic
 
  FNo = FreeFile
 
  On Error GoTo ErrHndl:

  Open strFilePath For Input As #FNo
  Line Input #FNo, txtData
  Cnt = 1
  Con.BeginTrans
  Do Until EOF(FNo)
    Line Input #FNo, txtData
    Select Case txtData
      Case "情報: 指定の条件に当てはまる 'application' ログのレコードはありません。"
        Err.Raise 999, , "情報: 指定の条件に当てはまる 'application' ログのレコードはありません。"
      Case ""
      Case " "
        Rec.Update
      Case Else
        Select Case Left(txtData, 4)
          Case "Type"
            If CommitFLG = True Then
              Rec.Update
              Cnt = Cnt + 1
              CommitFLG = False
            End If
            Rec.AddNew
            Rec![Messege_ID] = Cnt
            Rec![Messege_Type] = Mid(txtData, 14)
          Case "Even"
            Rec![Messege_Event] = Mid(txtData, 14)
          Case "Date"
            Rec![Messege_DateTime] = Mid(txtData, 14)
          Case "Sour"
            Rec![Messege_Source] = Mid(txtData, 14)
          Case "ComputerName "
            Rec![Messege_ComputerName] = Mid(txtData, 14)
          Case "Cate"
            Rec![Messege_Category] = Mid(txtData, 14)
          Case "User"
            Rec![Messege_User] = Mid(txtData, 14)
          Case "Desc"
            Rec![Messege_Description] = Mid(txtData, 14)
            CommitFLG = True
          Case Else
            If CommitFLG = True Then
              Rec![Messege_Description] = Rec![Messege_Description] & vbCrLf & Mid(txtData, 14)
            End If
      End Select
    End Select
  Loop
 
  Close #FNo
  Rec.Close
  Set Rec = Nothing
 
  Con.CommitTrans
  Set Con = Nothing
 
  MsgBox "正常終了"
  Exit Function

ErrHndl:
 
  Close #FNo
  Con.RollbackTrans
  Set Con = Nothing
 
  MsgBox Cnt & "行目で以下のエラーが発生したためロールバックしました。" & vbCrLf & _
      Err.Description, vbCritical

End Function

Function CreateTableApplog() As String
Dim strSQL As String

  strSQL = ""
  strSQL = strSQL & " CREATE TABLE T_ApplicationLog("
  strSQL = strSQL & " Messege_ID Long "
  strSQL = strSQL & " ,messege_Type Text(10) "
  strSQL = strSQL & " ,messege_Event Long "
  strSQL = strSQL & " ,Messege_DateTime Date "
  strSQL = strSQL & " ,messege_Source Text(50) "
  strSQL = strSQL & " ,Messege_ComputerName Text(50) "
  strSQL = strSQL & " ,Messege_Category Text(50) "
  strSQL = strSQL & " ,Messege_USER Text(50)"
  strSQL = strSQL & " ,Messege_Description Memo "
  strSQL = strSQL & " ,CONSTRAINT PK PRIMARY KEY (Messege_ID))"
 
  CreateTableApplog = strSQL
End Function


> インポートするたびにバッチ処理を動かしていると、
> サーバーに負荷がかかりすぎる為、

という事を考慮して日付を指定して1日分のみ
アプリケーションログを取ってくるようなコードです。

全てのアプリケーションログを取ってくる仕様ですし、
DateTime や Description は分割しておりませんが
何かしらの参考になれば幸いです。

  Call AppLogInsert("192.168.0.100", "Domain\User", "PWD", #12/11/2009#)

の様に呼び出してみて下さい。
1,448 hits

【11255】コマンドボタンを押下すると、指定ファルダ下にあるtxtをインポートしたい。 cocoa 09/12/4(金) 16:13 質問[未読]
【11256】Re:コマンドボタンを押下すると、指定ファルダ下に... 小僧 09/12/4(金) 19:35 発言[未読]
【11257】Re:コマンドボタンを押下すると、指定ファルダ下に... cocoa 09/12/7(月) 11:16 発言[未読]
【11258】Re:コマンドボタンを押下すると、指定ファルダ下に... cocoa 09/12/7(月) 14:23 質問[未読]
【11259】Re:コマンドボタンを押下すると、指定ファルダ下に... 小僧 09/12/7(月) 15:17 回答[未読]
【11261】Re:コマンドボタンを押下すると、指定ファルダ下に... cocoa 09/12/7(月) 16:25 質問[未読]
【11262】Re:コマンドボタンを押下すると、指定ファルダ下に... 小僧 09/12/7(月) 16:42 回答[未読]
【11263】Re:コマンドボタンを押下すると、指定ファルダ下に... cocoa 09/12/7(月) 16:53 質問[未読]
【11264】Re:コマンドボタンを押下すると、指定ファルダ下に... cocoa 09/12/7(月) 17:11 質問[未読]
【11265】Re:コマンドボタンを押下すると、指定ファルダ下に... 小僧 09/12/7(月) 17:27 回答[未読]
【11271】Re:コマンドボタンを押下すると、指定ファルダ下に... cocoa 09/12/8(火) 15:11 質問[未読]
【11272】Re:コマンドボタンを押下すると、指定ファルダ下に... 小僧 09/12/8(火) 18:57 発言[未読]
【11273】Re:コマンドボタンを押下すると、指定ファルダ下に... cocoa 09/12/9(水) 10:09 質問[未読]
【11274】Re:コマンドボタンを押下すると、指定ファルダ下に... 小僧 09/12/9(水) 11:09 回答[未読]
【11275】Re:コマンドボタンを押下すると、指定ファルダ下に... cocoa 09/12/9(水) 14:05 質問[未読]
【11276】Re:コマンドボタンを押下すると、指定ファルダ下に... 小僧 09/12/9(水) 19:22 発言[未読]
【11278】Re:コマンドボタンを押下すると、指定ファルダ下に... cocoa 09/12/10(木) 9:19 質問[未読]
【11279】Re:コマンドボタンを押下すると、指定ファルダ下に... 小僧 09/12/10(木) 9:45 回答[未読]
【11281】Re:コマンドボタンを押下すると、指定ファルダ下に... cocoa 09/12/10(木) 10:19 質問[未読]
【11282】Re:コマンドボタンを押下すると、指定ファルダ下に... 小僧 09/12/10(木) 12:46 回答[未読]
【11283】Re:コマンドボタンを押下すると、指定ファルダ下に... cocoa 09/12/10(木) 13:17 質問[未読]
【11284】Re:コマンドボタンを押下すると、指定ファルダ下に... cocoa 09/12/10(木) 14:30 質問[未読]
【11285】Re:コマンドボタンを押下すると、指定ファルダ下に... cocoa 09/12/10(木) 14:51 質問[未読]
【11286】Re:コマンドボタンを押下すると、指定ファルダ下に... cocoa 09/12/10(木) 15:13 質問[未読]
【11289】Re:コマンドボタンを押下すると、指定ファルダ下に... 小僧 09/12/11(金) 11:00 回答[未読]
【11290】Re:コマンドボタンを押下すると、指定ファルダ下に... cocoa 09/12/11(金) 11:46 お礼[未読]
【11292】Re:コマンドボタンを押下すると、指定ファルダ下に... 小僧 09/12/11(金) 15:23 発言[未読]
【11296】Re:コマンドボタンを押下すると、指定ファルダ下に... cocoa 09/12/14(月) 14:40 お礼[未読]
【11260】Re:コマンドボタンを押下すると、指定ファルダ下に... Nao 09/12/7(月) 15:19 回答[未読]
【11291】Re:コマンドボタンを押下すると、指定ファルダ下に... cocoa 09/12/11(金) 11:48 お礼[未読]

1982 / 9994 ←次へ | 前へ→
ページ:  ┃  記事番号:
1078197
(SS)C-BOARD v3.8 is Free