Access VBA質問箱 IV

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

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


526 / 2272 ツリー ←次へ | 前へ→

【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 お礼[未読]

【11255】コマンドボタンを押下すると、指定ファルダ下にあ...
質問  cocoa  - 09/12/4(金) 16:13 -

引用なし
パスワード
   初めて質問致します。
Access2003を使用しております。

フォームのコマンドボタン(EventLogAccess)を押下すると、
C:\temp\logにあるyyyy/mm/dd.txtを事前に作成しておいた、
INPUTテーブルへインポートしたいのですが、どのようにマクロ
を作成すればいいでしょうか?

またフォームには、コマンドボタンの他にテキストボックスで
日付を指定できるのですが、指定した日付のデータをインポート
したいのです。

例:2009/12/04
   取込開始←ボタンを押すと、上の日付のデータをC:\temp\log直下から
        該当する20091204.txtを探し、trueであれば、INPUTテーブルへ
        インポートし、falseであれば、指定日付エラーとしたいの
        です。

宜しくお願い致します。

【11256】Re:コマンドボタンを押下すると、指定ファルダ下...
発言  小僧  - 09/12/4(金) 19:35 -

引用なし
パスワード
   ▼cocoa さん:
こんにちは。

まず、画面上部の

>本サイトの基本方針をまとめました。こちら をご一読ください。

の こちら のリンク先をお読みになって下さい。

> してはいけない質問について

の 丸投げに相当していませんか?


> yyyy/mm/dd.txt

当方の環境(WindowsXP SP3)ですと
ファイル名に「/」を使うとWindowsに怒られてしまいますね。
下の方に

>20091204.txtを探し

とあるので yyyymmdd.txt で良いのでしょうか。


> どのようにマクロを作成すればいいでしょうか?

マクロだけだと難しいと思われます。
こちらの掲示板はAccessVBAの掲示板ですので
VBAを使っての処理なら可能ですね。


> 事前に作成しておいた、INPUTテーブルへインポートしたい

txtファイルの中身にもよるのですが、
例えばCSVファイル(カンマ区切りのデータ形式)であれば
TransferText メソッドで取り込む事が可能です。

既存のテーブルへの取込処理となると
ヘッダー行(列名の行)がついていない場合は
一工夫必要になってきます。


> 指定した日付のデータをインポートしたいのです。

指定したフォルダにファイルが存在するかどうかのチェックは
Dir関数で行う事ができます。

いきなり TransferTextメソッドを使い
エラーの返り値を見てファイルが存在しない事を
判断する事も可能ですね。

まずはご自分でできる所までやってみて
解らない所をご質問された方が回答が付きやすくなると思いますよ。

【11257】Re:コマンドボタンを押下すると、指定ファルダ下...
発言  cocoa  - 09/12/7(月) 11:16 -

引用なし
パスワード
   ▼小僧様
ご回答ありがとう御座います。


>まずはご自分でできる所までやってみて
>わからない所をご質問された方が回答が付きやすくなると思いますよ。

自分で考えた結果、わからない箇所を質問しており、小僧様の回答を参考に
調べて行こうと思います。
後、マクロとVBAって違うのですね。同じようなものと認識しておりました。

ファイル名の箇所は小僧様のおっしゃるとおり、記載ミスでございます。
yyyymmdd.txtです。
ご指摘ありがとうございます。

【11258】Re:コマンドボタンを押下すると、指定ファルダ下...
質問  cocoa  - 09/12/7(月) 14:23 -

引用なし
パスワード
   ▼小僧様
Option Compare Database
Option Explicit

Sub Test()
Dim txtData As String, FNo As Long, arrData, i As Integer
Dim Con As New ADODB.Connection, Rec As New ADODB.Recordset
Dim strFilePath As String, returnValue

  Call EventQuery
 
  '[ファイルを開く]ダイアログボックスを表示
  WizHook.Key = 51488399
  returnValue = WizHook.GetFileName( _
             0, "", "", "", strFilePath, "", _
             "CSVファイル (*.csv)|*.csv", _
             0, 0, 0, True _
             )
  WizHook.Key = 0
   
  '[キャンセル]がクリックされた場合は即終了
  If returnValue <> 0 Then
    Exit Sub
  End If
 
Set Con = CurrentProject.Connection
Rec.Open "INPUTDATA", Con, adOpenDynamic, adLockOptimistic
 
FNo = FreeFile
Open strFilePath For Input As #FNo
  'ファイルの1行目の項目名部分を読み込む(何も処理しない)
  Line Input #FNo, txtData
   
  On Error GoTo ErrHndl
  'エラーが発生した場合にデータのインポートをなかったこと(ロールバック)
  'にするためにトランザクション処理として実行
  Con.BeginTrans
    '実際のデータ部分(2行目)からの処理
    Do While Not EOF(FNo)
      Line Input #FNo, txtData
      arrData = Split(txtData, ",")
        Rec.AddNew
          '引用符を削除してからフィールドに値を代入する
          

          Rec("Date Time") = arrData(2)
          Rec("ComputerName") = arrData(4)
          Rec("Description") = arrData(7)
          
          
        Rec.Update
    Loop
     
  Con.CommitTrans
   
Close #FNo
Exit Sub
 
ErrHndl:
  Close #FNo
  Con.RollbackTrans
  MsgBox "以下のエラーが発生したためロールバックしました。" & vbCrLf & _
      Err.Description, vbCritical
   
End Sub

Function EventQuery()

  Dim objWSH As Object
    Set objWSH = CreateObject("WScript.Shell")
      objWSH.Run """C:\Documents and Settings\UserName\デスクトップ\EventLogAccess\eventlog\event.bat"""
    Set objWSH = Nothing
  
End Function


上記プログラムで質問なのですが、
【質問内容1.】
EventQuery(バッチ処理)はアプリケーションログを取得し、csvファイル形式で保存する処理なのですが、ファイルが保存されるまでEventQuery以下のプログラムを待機させておくことはできないでしょうか?
EventQuery処理が終了すると、走るようにしたいのです。

【質問内容2.】
フィールド『Description』は説明を取得するフィールドなのですが、
内容が、0____userName(_は半角スペース)です。
これをテーブルにインポートする際に数字とuserNameを分けてインポートできないものでしょうか?
例:Description1 Description2
  0       userName

宜しくお願い致します。

【11259】Re:コマンドボタンを押下すると、指定ファルダ下...
回答  小僧  - 09/12/7(月) 15:17 -

引用なし
パスワード
   ▼cocoa さん:
こんにちは。


>▼小僧様
回答者を指定すると
他の回答者が答えにくくなってしまいますよ^^;


> 【質問内容1.】
> EventQuery処理が終了すると、走るようにしたいのです。

Shell関数については非同期なので
同期実行させる必要があります。

Accessそのものには外部ファイルの実行完了を
監視する機能は付いていない為、
Windowsに付随する機能などを借りてくる形が良さそうです。

YU-TANG's MS-Access Discovery
DOS コマンドの実行結果を取得する方法
h tp://www.f3.dion.ne.jp/~element/msaccess/AcTipsGetDosResult.html

こちらのサイトの「処理完了を待機する」の辺り紹介されている方法が
ご参考になるかもしれません。


> 【質問内容2.】
> 0____userName
> 数字とuserNameを分けてインポートできないものでしょうか?

半角スペースが持つ意味によって変わってきます。

半角スペースが4個固定の場合はSplit関数を使って

Rec("Description1") = Split(arrData(7),"____")(0)
Rec("Description2") = Split(arrData(7),"____")(1)

の様に分割ができます。

桁数によって半角スペースが減る場合
(userNameが必ず6文字目から始まる場合)には

Rec("Description1") = RTrim(Left(arrData(7),5))
Rec("Description2") = Mid(arrData(7),6)

の様な文字列操作によって分割が可能ですね。

> Access2003を使用しております。
> WizHook.Key

WizHookオブジェクトは非公開オブジェクトの為、
代替が効くのであれば他の方法を取ったほうが無難かと思われます。

Access2003以前のバージョンを使わないのであれば
Office付随の FileDialog オブジェクト等も良いかもしれません。
h tp://msdn.microsoft.com/ja-jp/library/cc326127.aspx

【11260】Re:コマンドボタンを押下すると、指定ファルダ下...
回答  Nao  - 09/12/7(月) 15:19 -

引用なし
パスワード
   >【質問内容1.】
>EventQuery(バッチ処理)はアプリケーションログを取得し、csvファイル形式で保存する処理なのですが、ファイルが保存されるまでEventQuery以下のプログラムを待機させておくことはできないでしょうか?
>EventQuery処理が終了すると、走るようにしたいのです。


LogNameにログファイルのフルパス名を入れて、作成されるまで
以下の処理で待たせる。

 Do
  If Nz(Dir(LogName), "") <> "" Then Exit Do
  DoEvents
 Loop


>【質問内容2.】
>フィールド『Description』は説明を取得するフィールドなのですが、
>内容が、0____userName(_は半角スペース)です。
>これをテーブルにインポートする際に数字とuserNameを分けてインポートできないものでしょうか?
>例:Description1 Description2
>  0       userName
>


インポートしてからSplit関数でデータを分離する。

【11261】Re:コマンドボタンを押下すると、指定ファルダ下...
質問  cocoa  - 09/12/7(月) 16:25 -

引用なし
パスワード
   ▼小僧様 皆様
>> 【質問内容2.】
>> 0____userName
>> 数字とuserNameを分けてインポートできないものでしょうか?
>
>半角スペースが持つ意味によって変わってきます。
>
>半角スペースが4個固定の場合はSplit関数を使って
>
>Rec("Description1") = Split(arrData(7),"____")(0)
>Rec("Description2") = Split(arrData(7),"____")(1)
上記のSplit関数を使用して、上図の_を半角スペースに変換して
実行してもエラーとなってしまいます。

▼エラー内容
実行時エラー'3265' 要求された名前または序数に対応する項目がコレクションで見つかりません。

いろいろ試したのですが、インデックスが有効範囲ではありません。等のエラーが
でたりもします。

宜しくお願い致します。

【11262】Re:コマンドボタンを押下すると、指定ファルダ下...
回答  小僧  - 09/12/7(月) 16:42 -

引用なし
パスワード
   ▼cocoa さん:
こんにちは。

> 実行時エラー'3265' 要求された名前または
> 序数に対応する項目がコレクションで見つかりません。

テーブル上に該当するフィールド名がないと
このエラーが出る様です。

>>> 例:Description1 Description2
>>>   0       userName

INPUTDATA テーブルに Description1, Description2 という
列はありますでしょうか。


> インデックスが有効範囲ではありません。等のエラーが
> でたりもします。

>> 半角スペースが4個固定の場合はSplit関数を使って

と先ほど提示致しましたが、
半角スペース4個ではないデータがあると
この様なエラーが発生しますね。

【11263】Re:コマンドボタンを押下すると、指定ファルダ下...
質問  cocoa  - 09/12/7(月) 16:53 -

引用なし
パスワード
   ▼小僧様
お世話になります。

>テーブル上に該当するフィールド名がないと
>このエラーが出る様です。
>
>>>> 例:Description1 Description2
>>>>   0       userName
>
>INPUTDATA テーブルに Description1, Description2 という
>列はありますでしょうか。
作成してみると、エラーはでなくなりました。が、

>> インデックスが有効範囲ではありません。等のエラーが
>> でたりもします。
>
>>> 半角スペースが4個固定の場合はSplit関数を使って
>
>と先ほど提示致しましたが、
>半角スペース4個ではないデータがあると
>この様なエラーが発生しますね。
インデックスが有効範囲エラーとなります。
全て半角4個のデータなのです。

というのも、説明部分は自分でそういうメッセージにしているので、
固定で4個なのです。
もちろん変えることも可能なのですが、どのようにすればいいでしょうか?

【11264】Re:コマンドボタンを押下すると、指定ファルダ下...
質問  cocoa  - 09/12/7(月) 17:11 -

引用なし
パスワード
   ▼小僧様 皆様
連投申し訳ありません。

>と先ほど提示致しましたが、
>半角スペース4個ではないデータがあると
>この様なエラーが発生しますね。
インデックスの有効範囲にありません。というエラーは発生
するのですが、データ自体はインポートされております。
半角スペース4以外のものだけ省かれてインポートされていると
いうことなのでしょうか?
ん〜、全て半角スペース4つなのですが。


質問ばかりで申し訳ありません。
宜しくお願い致します。

【11265】Re:コマンドボタンを押下すると、指定ファルダ下...
回答  小僧  - 09/12/7(月) 17:27 -

引用なし
パスワード
   ▼cocoa さん:
こんにちは。

> データ自体はインポートされております。

ご提示されたコードの通り実行されているとすると、
1つでもデータにエラーがあった場合は
テーブルに書き込まない処理になってますね。

INPUTDATA テーブルを空っぽにしてから
もう一度テストされてみて下さい。


テーブルに書き込みの処理があったり、
ファイルを選ぶ処理があったりすると複雑になるので
下記の様なコードで試されてみて下さい。


Sub test2()
Const strFilePath = "C:\Test.csv"
Dim FNo As Long
Dim txtData As String
Dim arrData As Variant
Dim i As Long

  FNo = FreeFile
  Open strFilePath For Input As #FNo
    
  Line Input #FNo, txtData
  
  i = 2
   Do While Not EOF(FNo)
      
    Line Input #FNo, txtData
    
    arrData = Split(txtData, ",")
    
    If InStr(1, arrData(7), "  ") = 0 Then
      MsgBox i & "行目にスペース4つがありません" _
          & vbCrLf & vbCrLf & "DATA:" & arrData(7)
      GoTo ExitEXE
    End If
    i = i + 1
   Loop

ExitEXE:
  Close #FNo

End Sub


メモ帳でCSVファイルを開くと半角4つ分の空白ですけど、
実はTABコードだったり…という事はありませんよね…。

【11271】Re:コマンドボタンを押下すると、指定ファルダ下...
質問  cocoa  - 09/12/8(火) 15:11 -

引用なし
パスワード
   ▼小僧様 皆様
>メモ帳でCSVファイルを開くと半角4つ分の空白ですけど、
>実はTABコードだったり…という事はありませんよね…。
半角4つ分の空白で間違いありません。

戴いた、サンプルを実行させてみたところ、271行目に半角4つ分のスペースでは
ないところを発見しました。
データが入っていない行なのですが、インポートしようとしているみたいです。
なので、エラーはでるものの、データのインポート自体は成功しているようです。
どのようにすれば、データがある部分だけをインポートできるのでしょうか?

宜しくお願い致します。

【11272】Re:コマンドボタンを押下すると、指定ファルダ下...
発言  小僧  - 09/12/8(火) 18:57 -

引用なし
パスワード
   ▼cocoa さん:
こんにちは。

>戴いた、サンプルを実行させてみたところ、271行目に半角4つ分のスペースでは
>ないところを発見しました。
>データが入っていない行なのですが、インポートしようとしているみたいです。
>なので、エラーはでるものの、データのインポート自体は成功しているようです。
>どのようにすれば、データがある部分だけをインポートできるのでしょうか?

ごめんなさい。
仰っている事がさっぱり解らないです。


>データが入っていない行なのですが、インポートしようとしているみたいです。

データが入っていない行、というのはどういう状態なのでしょうか。

1,xxx,100,"1  小僧"[改行]
2,yyy,300,"2  cocoa"[改行]
[改行]
4,zzz,400,"3  Nao"[改行]

の様に、改行コードのみの行が存在しているのでしょうか。

それとも271行目でデータは終わっているのに
Loop を抜けないでエラーが出てしまうのでしょうか。


>> ご提示されたコードの通り実行されているとすると、
>> 1つでもデータにエラーがあった場合は
>> テーブルに書き込まない処理になってますね。

> エラーはでるものの、データのインポート自体は成功しているようです。

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


現在どの様なコードで実験を行っているのかが解りませんが、
少なくともご提示されたコードの中では
エラールーチンで Rollback している訳ですから
データが入る事はありえないですよね。

掲示版でのやりとりですので
正確な情報が解らないと無駄なやりとりの繰り返しになりますよ。


【質問内容1.】に関しては解決したのでしょうか?
cocoa さんと同じ様に困っている方が
Webで検索してこちらの記事を読まれるかもしれません。
解決したのであれば、
どの様にコードを書き直したのかを載せるのが
エチケットだと思いますよ。

【11273】Re:コマンドボタンを押下すると、指定ファルダ下...
質問  cocoa  - 09/12/9(水) 10:09 -

引用なし
パスワード
   ▼小僧様 皆様
すいません。
小僧様より戴いたサンプルを実行しました。
Sub test2()
Const strFilePath = "C:\Documents and Settings\UserName\デスクトップ\EventLogAccess\eventlog\20091208.csv"
Dim FNo As Long
Dim txtData As String
Dim arrData As Variant
Dim i As Long

  FNo = FreeFile
  Open strFilePath For Input As #FNo
  
  Line Input #FNo, txtData
 
  i = 2
   Do While Not EOF(FNo)
   
    Line Input #FNo, txtData
  
    arrData = Split(txtData, ",")
  
    If InStr(1, arrData(7), "  ") = 0 Then
      MsgBox i & "行目にスペース4つがありません" _
          & vbCrLf & vbCrLf & "DATA:" & arrData(7)
      GoTo ExitEXE
    End If
    i = i + 1
   Loop

ExitEXE:
  Close #FNo

End Sub

上記プログラムを実行した結果、271行目(最終行)が半角4つ分の空白ではない行ですというエラーになりました。

>それとも271行目でデータは終わっているのに
>Loop を抜けないでエラーが出てしまうのでしょうか。
↑これです。270行目までしかデータはないのです。
が、271行目もみにいってしまっています。
※ちなみに、271行目を削除して実行してみるとエラーはおきませんでした。

>現在どの様なコードで実験を行っているのかが解りませんが、
>少なくともご提示されたコードの中では
>エラールーチンで Rollback している訳ですから
>データが入る事はありえないですよね。
Sub Test()
Dim txtData As String, FNo As Long, arrData, i As Integer
Dim Con As New ADODB.Connection, Rec As New ADODB.Recordset
 
Set Con = CurrentProject.Connection
Rec.Open "INPUTDATA", Con, adOpenDynamic, adLockOptimistic
 
FNo = FreeFile
Open "C:\Documents and Settings\UserName\デスクトップ\EventLogAccess\eventlog\20091208.csv" For Input As #FNo
  'ファイルの1行目の項目名部分を読み込む(何も処理しない)
  Line Input #FNo, txtData

   
    '実際のデータ部分(2行目)からの処理
    Do While Not EOF(FNo)
      Line Input #FNo, txtData
      arrData = Split(txtData, ",")
        Rec.AddNew
          '引用符を削除してからフィールドに値を代入する
          
          Rec("Date") = Split(arrData(2), " ")(0)
          Rec("Time") = Split(arrData(2), " ")(1)
          Rec("ComputerName") = arrData(4)
          Rec("Description1") = Split(arrData(7), "  ")(0)
          Rec("Description2") = Split(arrData(7), "  ")(1)
          
        Rec.Update
    Loop
     
  Close #FNo
   
End Sub
上記プログラムで実験しておりました。
なので、ロールバックはせず、エラー以外のデータが入るようになっておりました。すいません。

【質問内容1.】に関しては解決したのでしょうか?
まだ解決しておりません。質問内容2がきになり、手がつけれていない状態です。

【11274】Re:コマンドボタンを押下すると、指定ファルダ下...
回答  小僧  - 09/12/9(水) 11:09 -

引用なし
パスワード
   ▼cocoa さん:
こんにちは。

>>【質問内容1.】に関しては解決したのでしょうか?
>まだ解決しておりません。質問内容2がきになり、手がつけれていない状態です。

かしこまりました。
質問内容2から片づけていきましょう!

> 270行目までしかデータはないのです。
> が、271行目もみにいってしまっています。

最終行(271行目)は
改行コードだけがあるのでしょうか…。


arrData = Split(txtData, ",")

の次行に

If UBound(arrData) = -1 Then
  Exit Do
End If

の様に、「,」の無いデータ行が出たら
Loop を抜ける様にしてみましょう。

【11275】Re:コマンドボタンを押下すると、指定ファルダ下...
質問  cocoa  - 09/12/9(水) 14:05 -

引用なし
パスワード
   ▼小僧様 皆様
>最終行(271行目)は
>改行コードだけがあるのでしょうか…。
うまく説明できなくて申し訳ないです。
改行コードだけかどうかはわからないのですが、データはないです。
フィールド1 フィールド2 ...フィールド8まであります。
1
2
.
.
.
270 データあり データあり ...データあり
271 データなし データなし ...データなし

でもALT + A で選択すると、271行目フィールド8まで選択されます。

Sub Test()
Dim txtData As String, FNo As Long, arrData, i As Integer
Dim Con As New ADODB.Connection, Rec As New ADODB.Recordset
 
Set Con = CurrentProject.Connection
Rec.Open "INPUTDATA", Con, adOpenDynamic, adLockOptimistic
 
FNo = FreeFile
Open "C:\Documents and Settings\UserName\デスクトップ\EventLogAccess\eventlog\20091209.csv" For Input As #FNo
  'ファイルの1行目の項目名部分を読み込む(何も処理しない)
  Line Input #FNo, txtData

   
    '実際のデータ部分(2行目)からの処理
    Do While Not EOF(FNo)
      Line Input #FNo, txtData
      arrData = Split(txtData, ",")
        If UBound(arrData) = -1 Then
          Exit Do
        End If
        Rec.AddNew
          '引用符を削除してからフィールドに値を代入する
          
          Rec("Date") = Split(arrData(2), " ")(0)'←(yyyy/mm/dd__00:00:00)
          Rec("Time") = Split(arrData(2), " ")(1)
          Rec("ComputerName") = arrData(4)
          Rec("Description1") = Split(arrData(7), "  ")(0)
          Rec("Description2") = Split(arrData(7), "  ")(1)
          
        Rec.Update
        
        
    Loop
     
  Close #FNo
   
End Sub

上記プログラムを実行すると、270行目までのデータはインポートされておりました。が、インデックスエラーがでます。

宜しくお願い致します。

【11276】Re:コマンドボタンを押下すると、指定ファルダ下...
発言  小僧  - 09/12/9(水) 19:22 -

引用なし
パスワード
   ▼cocoa さん:

こんにちは。

>271 データなし データなし ...データなし
>
>でもALT + A で選択すると、271行目フィールド8まで選択されます。

この状態がはっきりと解らないと的確な回答が付けにくいです。

CSVファイルをメモ帳(テキストエディタ)で開くと
「,」は存在しているのでしょうか。

また、ご提示された情報を見ると
1列目の番号のみデータが入ってるのでしょうか。

「データなし」がどの様な状態であるのかの情報を
もうちょっと具体的にご提示して下さい。


269,xxx,20091209 190000,aaaa,bbb,CP-01,0,1  kozo
270,yyy,20091209 190001,aaaa,bbb,CP-02,0,2  cocoa



271
271________________________________________________(_は半角スペース)
271,  ,        ,  ,  ,   , ,     
271,,,,,,,,


> インデックスエラーがでます。

INPUTDATAテーブル のどの列に Index を貼ったかの情報がないと
こちらとしては何とも言えません…。

【11278】Re:コマンドボタンを押下すると、指定ファルダ下...
質問  cocoa  - 09/12/10(木) 9:19 -

引用なし
パスワード
   ▼小僧様 皆様
>269,xxx,20091209 190000,aaaa,bbb,CP-01,0,1  kozo
>270,yyy,20091209 190001,aaaa,bbb,CP-02,0,2  cocoa
>271
>271________________________________________________(_は半角スペース)
>271,  ,        ,  ,  ,   , ,     
>271,,,,,,,,
271行目(最終行)の1列目には半角スペースが先頭に一つ入っておりました!!
2列目以降はなにもデータはありません。空白です。,もありません。


Sub Test()
Dim txtData As String, FNo As Long, arrData, i As Integer
Dim Con As New ADODB.Connection, Rec As New ADODB.Recordset
 
Set Con = CurrentProject.Connection
Rec.Open "INPUTDATA", Con, adOpenDynamic, adLockOptimistic
 
FNo = FreeFile
Open "C:\Documents and Settings\UserName\デスクトップ\EventLogAccess\eventlog\20091209.csv" For Input As #FNo
  'ファイルの1行目の項目名部分を読み込む(何も処理しない)
  Line Input #FNo, txtData

   
    '実際のデータ部分(2行目)からの処理
    Do While Not EOF(FNo)
      Line Input #FNo, txtData
      arrData = Split(txtData, ",")
        If UBound(arrData) = -1 Then
          Exit Do
        End If
        Rec.AddNew
          '引用符を削除してからフィールドに値を代入する
          Rec("Date") = Split(arrData(2), " ")(0)←この部分でインデックスエラーとなります。
          Rec("Time") = Split(arrData(2), " ")(1)
          Rec("ComputerName") = arrData(4)
          Rec("Description1") = Split(arrData(7), "  ")(0)
          Rec("Description2") = Split(arrData(7), "  ")(1)
          
        Rec.Update
        
    Loop
     
  Close #FNo
   
End Sub

インデックスエラーについては、最終行をみに行ったときに、空白なので、Split関数のインデックスが間違っている。とエラーになると予想致しました。

インデックスエラーについては解決致しました。

説明不足で申し訳ないです。
宜しくお願い致します。

【11279】Re:コマンドボタンを押下すると、指定ファルダ下...
回答  小僧  - 09/12/10(木) 9:45 -

引用なし
パスワード
   ▼cocoa さん:
こんにちは。

>271行目(最終行)の1列目には半角スペースが先頭に一つ入っておりました!!

> If UBound(arrData) = -1 Then

 If arrData(0) = " " Then

で判断できそうですね。

【11281】Re:コマンドボタンを押下すると、指定ファルダ下...
質問  cocoa  - 09/12/10(木) 10:19 -

引用なし
パスワード
   ▼小僧様 皆様
こんにちはです。

>>271行目(最終行)の1列目には半角スペースが先頭に一つ入っておりました!!
>
>> If UBound(arrData) = -1 Then
>↓
> If arrData(0) = " " Then
>
>で判断できそうですね。

判断できました!!!
ありがとうございます。

後、質問内容1.の方ですが、バッチ処理とは別にしようとおもっております。
インポートするたびにバッチ処理を動かしていると、サーバーに負荷が
かかりすぎる為、やめようと思います。
回答していただいた皆様、申し訳ないです。

後、もう一つだけいいでしょうか?
実は、'実際のデータ部分(2行目)からの処理
とあるのですが、実際のデータ部分は8行目からなのです。
毎回1〜7行を削除して実行していたのですが、
'実際のデータ部分(8行目)からの処理というように
プログラムを変更するにはどうしたらいいのでしょうか?

Private Sub EventLogAccess_Click()
Dim txtData As String, FNo As Long, arrData, i As Integer
Dim Con As New ADODB.Connection, Rec As New ADODB.Recordset
Dim strFilePath As String, returnValue

DoCmd.RunSQL "Delete From INPUTDATA"
  '[ファイルを開く]ダイアログボックスを表示
  WizHook.Key = 51488399
  returnValue = WizHook.GetFileName( _
             0, "", "", "", strFilePath, "", _
             "CSVファイル (*.csv)|*.csv", _
             0, 0, 0, True _
             )
  WizHook.Key = 0
   
  '[キャンセル]がクリックされた場合は即終了
  If returnValue <> 0 Then
    Exit Sub
  End If
 
Set Con = CurrentProject.Connection
Rec.Open "INPUTDATA", Con, adOpenDynamic, adLockOptimistic
 
FNo = FreeFile
Open strFilePath For Input As #FNo
  'ファイルの1行目の項目名部分を読み込む(何も処理しない)
  Line Input #FNo, txtData
   
  On Error GoTo ErrHndl
  'エラーが発生した場合にデータのインポートをなかったこと(ロールバック)
  'にするためにトランザクション処理として実行
  Con.BeginTrans
    '実際のデータ部分(2行目)からの処理
    Do While Not EOF(FNo)
      Line Input #FNo, txtData
      arrData = Split(txtData, ",")
        If arrData(0) = " " Then
          Exit Do
        End If
        Rec.AddNew
          '引用符を削除してからフィールドに値を代入する
          

          Rec("Date") = Split(arrData(2), " ")(0)
          Rec("Time") = Split(arrData(2), " ")(1)
          Rec("ComputerName") = arrData(4)
          Rec("Description1") = Split(arrData(7), "  ")(0)
          Rec("Description2") = Split(arrData(7), "  ")(1)

          
        Rec.Update

    Loop
     
  Con.CommitTrans
   
Close #FNo
DoCmd.OpenForm "TimeForm", acPreview
Exit Sub
 
ErrHndl:
  Close #FNo
  Con.RollbackTrans
  MsgBox "以下のエラーが発生したためロールバックしました。" & vbCrLf & _
      Err.Description, vbCritical


End Sub

※このプログラム自体も私が書いたものではない為、全く理解しておりません。
 これを気に勉強しようと思います。

宜しくお願い致します。

【11282】Re:コマンドボタンを押下すると、指定ファルダ下...
回答  小僧  - 09/12/10(木) 12:46 -

引用なし
パスワード
   ▼cocoa さん:
こんにちは。

> 毎回1〜7行を削除して実行していたのですが、
> 実際のデータ部分(8行目)

1行目を飛ばす処理がプログラムに入っているので
実際に削ったのは2〜7行目でしょうか。


多少変更を加えて下記の様にしてみました。

Private Sub EventLogAccess_Click()
Dim txtData As String
Dim FNo As Long
Dim arrData As Variant
Dim i As Integer
Dim Con As New ADODB.Connection
Dim Rec As New ADODB.Recordset
Dim strFilePath As String
Dim returnValue As Long
 
  '[ファイルを開く]ダイアログボックスを表示
  WizHook.Key = 51488399

  returnValue = WizHook.GetFileName( _
             0, "", "", "", strFilePath, "", _
             "CSVファイル (*.csv)|*.csv", _
             0, 0, 0, True _
             )
  WizHook.Key = 0
  
  '[キャンセル]がクリックされた場合は即終了
  If returnValue <> 0 Then
    Exit Sub
  End If

  Set Con = CurrentProject.Connection
  
  Con.Execute "Delete From INPUTDATA"
  Rec.Open "INPUTDATA", Con, adOpenDynamic, adLockOptimistic

  FNo = FreeFile
  
  Open strFilePath For Input As #FNo
  
  '先頭〜7行目までを読み飛ばす
  For i = 1 To 7
    Line Input #FNo, txtData
  Next i
  
  On Error GoTo ErrHndl
  'エラーが発生した場合にデータのインポートをなかったこと(ロールバック)
  'にするためにトランザクション処理として実行
  
  Con.BeginTrans
    
  '実際のデータ部分(8行目)から
  'EOF(End Of File)までループ
    
    Do Until EOF(FNo)
      Line Input #FNo, txtData
      arrData = Split(txtData, ",")
          
    '先頭に半角スペースがあった場合はループを抜ける
      If arrData(0) = " " Then
        Exit Do
      Else
        Rec.AddNew
        Rec("xxDate") = Split(arrData(2), " ")(0)
        Rec("xxTime") = Split(arrData(2), " ")(1)
        Rec("ComputerName") = arrData(4)
        Rec("Description1") = Split(arrData(7), "  ")(0)
        Rec("Description2") = Split(arrData(7), "  ")(1)
        Rec.Update
      End If
    Loop
  
  Close #FNo
  Rec.Close
  Set Rec = Nothing
   
  Con.CommitTrans
  Con.Close
  Set Con = Nothing
  
  DoCmd.OpenForm "TimeForm", acPreview
  Exit Sub

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


> Rec("Date") = Split(arrData(2), " ")(0)
> Rec("Time") = Split(arrData(2), " ")(1)

INPUTDATA テーブルの「Date」「Time」という列名は予約語です。

h tp://support.microsoft.com/default.aspx?scid=kb;ja;286335

予約語を列名にすると
予期しない箇所でエラーが出る事がありますので、
列名の変更をした方が無難ですね。


> DoCmd.RunSQL "Delete From INPUTDATA"

DoCmd は非同期の処理なので
DELETE が全部終わらない内に
次の処理が始まる可能性があります。

今回はファイルダイアログを出す処理を挟むので
特に問題はないと思われますが、
ADO.Connection の Excute メソッドにて同期処理が取れるので
変更を加えてあります。

【11283】Re:コマンドボタンを押下すると、指定ファルダ下...
質問  cocoa  - 09/12/10(木) 13:17 -

引用なし
パスワード
   ▼小僧様
>> 毎回1〜7行を削除して実行していたのですが、
>> 実際のデータ部分(8行目)
>
>1行目を飛ばす処理がプログラムに入っているので
>実際に削ったのは2〜7行目でしょうか。
実際に削っていたのは1〜7行目です。
8行目はフィールド名になります。
なので、9行目からが実際のデータになります。
説明不足で申し訳ないです。

ちなみに戴いたサンプルですと、インデックスが有効範囲にない。という
エラーになりました。

何度も申し訳ありません。
宜しくお願い致します。

【11284】Re:コマンドボタンを押下すると、指定ファルダ下...
質問  cocoa  - 09/12/10(木) 14:30 -

引用なし
パスワード
   >▼小僧様
Option Compare Database
Option Explicit

Private Sub EventLogAccess_Click()
Dim txtData As Variant, FNo As Long, arrData, i As Integer
Dim Con As New ADODB.Connection, Rec As New ADODB.Recordset
Dim strFilePath As String, returnValue

DoCmd.RunSQL "Delete From INPUTDATA"
  '[ファイルを開く]ダイアログボックスを表示
  WizHook.Key = 51488399
  returnValue = WizHook.GetFileName( _
             0, "", "", "", strFilePath, "", _
             "CSVファイル (*.csv)|*.csv", _
             0, 0, 0, True _
             )
  WizHook.Key = 0
   
  '[キャンセル]がクリックされた場合は即終了
  If returnValue <> 0 Then
    Exit Sub
  End If
 
Set Con = CurrentProject.Connection
Rec.Open "INPUTDATA", Con, adOpenDynamic, adLockOptimistic
 
FNo = FreeFile
Open strFilePath For Input As #FNo
  'ファイルの1行目の項目名部分を読み込む(何も処理しない)
  
  For i = 1 To 8
    Line Input #FNo, txtData
  Next i
   
  On Error GoTo ErrHndl
  'エラーが発生した場合にデータのインポートをなかったこと(ロールバック)
  'にするためにトランザクション処理として実行
  Con.BeginTrans
    '実際のデータ部分(2行目)からの処理
    Do While Not EOF(FNo)
      Line Input #FNo, txtData
      arrData = Split(txtData, ",")
        If arrData(0) = " " Then
          Exit Do
        End If
        Rec.AddNew
          '引用符を削除してからフィールドに値を代入する
          

          Rec("日付") = Split(arrData(2), " ")(0)
          Rec("時間") = Split(arrData(2), " ")(1)
          Rec("ComputerName") = arrData(4)
          Rec("Description1") = Split(arrData(7), "  ")(0)
          Rec("Description2") = Split(arrData(7), "  ")(1)

          
        Rec.Update

    Loop
     
  Con.CommitTrans
   
Close #FNo
DoCmd.OpenForm "TimeForm", acPreview
Exit Sub
 
ErrHndl:
  Close #FNo
  Con.RollbackTrans
  MsgBox "以下のエラーが発生したためロールバックしました。" & vbCrLf & _
      Err.Description, vbCritical


End Sub

上記のようにしたところ、yyyymmdd.csvのデータを編集しなくても、INPUTDATAテーブルへインポートされました。

しかしインポートされたデータが""で囲まれてしまったのです。
例:フィールド1 フィールド2 フィールド3・・・
  "2009/12/10  12:00:00"   "ComputerName"

のような感じで、Split関数で分離させたものは、片方ずつに"が付き。
Split関数を使用していないものは両端が""で囲まれておりました。
そのため、正常に時間を取得させることができなくなったのです。


Line Input #FNo, txtData←この時に全てのデータが""で囲まれていました。

  For i = 1 To 8
    Line Input #FNo, txtData
  Next i
  ↑この文を入れると、そうなるのでしょうか?

ちなみに小僧様より戴いた、サンプルではFor文の箇所を
1 to 8にしてもなぜか、インデックスが有効範囲にありませんと
エラーが出ます。

Do while not
Do Until の部分が違うからでしょうか?

一から勉強していては今回の業務には間に合いそうにもありませんので、
どうかご協力をお願い致します。
もちろん小僧様のお時間が許すときで結構ですので、ご返信の程
お願い致します。

【11285】Re:コマンドボタンを押下すると、指定ファルダ下...
質問  cocoa  - 09/12/10(木) 14:51 -

引用なし
パスワード
   ▼小僧様 皆様
Private Sub EventLogAccess_Click()
Dim txtData As String
Dim FNo As Long
Dim arrData As Variant
Dim i As Integer
Dim Con As New ADODB.Connection
Dim Rec As New ADODB.Recordset
Dim strFilePath As String
Dim returnValue As Long
 
  '[ファイルを開く]ダイアログボックスを表示
  WizHook.Key = 51488399

  returnValue = WizHook.GetFileName( _
             0, "", "", "", strFilePath, "", _
             "CSVファイル (*.csv)|*.csv", _
             0, 0, 0, True _
             )
  WizHook.Key = 0
 
  '[キャンセル]がクリックされた場合は即終了
  If returnValue <> 0 Then
    Exit Sub
  End If

  Set Con = CurrentProject.Connection
 
  Con.Execute "Delete From INPUTDATA"
  Rec.Open "INPUTDATA", Con, adOpenDynamic, adLockOptimistic

  FNo = FreeFile
 
  Open strFilePath For Input As #FNo
 
  '先頭〜7行目までを読み飛ばす
  For i = 1 To 8
    Line Input #FNo, txtData
  Next i
 
  On Error GoTo ErrHndl
  'エラーが発生した場合にデータのインポートをなかったこと(ロールバック)
  'にするためにトランザクション処理として実行
 
  Con.BeginTrans
  
  '実際のデータ部分(8行目)から
  'EOF(End Of File)までループ
  
    Do Until EOF(FNo)
      Line Input #FNo, txtData
      arrData = Split(txtData, ",")
     
    '先頭に半角スペースがあった場合はループを抜ける
      If arrData(0) = " " Then
        Exit Do
      Else
        Rec.AddNew
        Rec("日付") = Split(arrData(2), " ")(0)
        Rec("時間") = Split(arrData(2), " ")(1)
        Rec("ComputerName") = arrData(4)
        Rec("Description1") = Split(arrData(7), "  ")(0)
        Rec("Description2") = Split(arrData(7), "  ")(1)
        Rec.Update
      End If
    Loop
 
  Close #FNo
  Rec.Close
  Set Rec = Nothing
 
  Con.CommitTrans
  Con.Close
  Set Con = Nothing
 
  DoCmd.OpenForm "TimeForm", acPreview
  Exit Sub

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


小僧様に戴いたサンプルで、下記箇所が全角スペース2つになっておりました。
        Rec("Description1") = Split(arrData(7), "  ")(0)
        Rec("Description2") = Split(arrData(7), "  ")(1)
上記を半角スペース4つになおして、For文の箇所を1 to 8 へ変更した所、
CSVデータを編集せずにインポートする事ができました。
ただ、前の質問の通り、""が付いてしまいます。

For文でくるくるすると、csvデータは文字列になるのでしょうか?

連投申し訳ありませんが、宜しくお願い致します。

【11286】Re:コマンドボタンを押下すると、指定ファルダ下...
質問  cocoa  - 09/12/10(木) 15:13 -

引用なし
パスワード
   ▼小僧様 皆様
こんにちは。

インポート定義が怪しいような感じでしょうか?

不要行1〜8行のうち、1〜7行は1列目に長い文章があります。その他の列は空白です。
Microsoft (R) Windows Script Host Version 5.7
Copyright (C) Microsoft Corporation 1996-2001. All rights reserved.


-------------------------------------------------------------------------
ホスト 'ServerName' の 'application' ログのイベントを一覧表示しています。
-------------------------------------------------------------------------
フィールド1,フィールド2,フィールド3...フィールド8
ここからが実データになります。

この場合、""で囲まれてしまわないようにするには、どうすればいいのでしょうか?

宜しくお願い致します。

【11289】Re:コマンドボタンを押下すると、指定ファルダ下...
回答  小僧  - 09/12/11(金) 11:00 -

引用なし
パスワード
   ▼cocoa さん:
こんにちは。 

> インポート定義が怪しいような感じでしょうか?

インポート定義を気にしなければいけないのは
TransferText メソッドを使った時ですので
今回は関係ないですね。


cocoa さんの2回目の投稿で

> '引用符を削除してからフィールドに値を代入する
>         
>
> Rec("Date Time") = arrData(2)
> Rec("ComputerName") = arrData(4)
> Rec("Description") = arrData(7)

とあるのですが、
コメント行から Rec…の間に何か処理入ってなかったでしょうか?

何も処理が入っていなかった場合は
Replace関数を使うと回避できそうですね。

'arrData = Split(txtData, ",")
'↓
arrData = Split(Replace(txtData, """", ""), ",")

【11290】Re:コマンドボタンを押下すると、指定ファルダ下...
お礼  cocoa  - 09/12/11(金) 11:46 -

引用なし
パスワード
   ▼小僧様
ありがとうございます!!
>'arrData = Split(txtData, ",")
>'↓
>arrData = Split(Replace(txtData, """", ""), ",")
回避しました!!
過去ログを漁っていましたが、検討違いのところをみていたようです。
過去ログに違う掲示板で小僧様の回答をよく目にしておりました。

長期間お付き合いして頂きありがとうございます。
質問側から回答できる立場になれるよう精進致します。

また、今回のロジックに関しては理解できるまで勉強致します。

ありがとうございました。

【11291】Re:コマンドボタンを押下すると、指定ファルダ下...
お礼  cocoa  - 09/12/11(金) 11:48 -

引用なし
パスワード
   ▼Nao さん:
>>【質問内容1.】
>>EventQuery(バッチ処理)はアプリケーションログを取得し、csvファイル形式で保存する処理なのですが、ファイルが保存されるまでEventQuery以下のプログラムを待機させておくことはできないでしょうか?
>>EventQuery処理が終了すると、走るようにしたいのです。
>
>
>LogNameにログファイルのフルパス名を入れて、作成されるまで
>以下の処理で待たせる。
>
> Do
>  If Nz(Dir(LogName), "") <> "" Then Exit Do
>  DoEvents
> Loop
すいません。VBAの実行中にbatを走らせるのはやめようと思います。
ただ、戴いたサンプルをテスト実行した結果、欲しい結果となりました。
ありがとう御座います。
>
>
>>【質問内容2.】
>>フィールド『Description』は説明を取得するフィールドなのですが、
>>内容が、0____userName(_は半角スペース)です。
>>これをテーブルにインポートする際に数字とuserNameを分けてインポートできないものでしょうか?
>>例:Description1 Description2
>>  0       userName
>>
>
>
>インポートしてからSplit関数でデータを分離する。
Split関数の勉強をさせていただきます。
ありがとうございます。

【11292】Re:コマンドボタンを押下すると、指定ファルダ下...
発言  小僧  - 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#)

の様に呼び出してみて下さい。

【11296】Re:コマンドボタンを押下すると、指定ファルダ下...
お礼  cocoa  - 09/12/14(月) 14:40 -

引用なし
パスワード
   ▼小僧様
>> -------------------------------------------------------------------------
>> ホスト 'ServerName' の 'application' ログのイベントを一覧表示しています。
>> -------------------------------------------------------------------------
>
>この情報が早く欲しかったです(笑)
ほんとすいません。

>cocoa さんの環境ですと Description が
>
>> 内容が、0____userName(_は半角スペース)です。
>
>という事なので、
>バッチファイルで何か特殊なアプリケーションのみ
>ログを抽出しているという事なのでしょうかね。
仰るとおりです。
ADサーバーのログオン・ログオフスクリプトでWHSを実行しております。
内容は、ドメインユーザーのログオン時間、ログオフ時間をアプリケーションログへ送出しております。

ほんとにありがとう御座いました。
今回戴いたサンプルも理解するまでには時間がかかると思いますが、
またご返事させていただきます!

また何かありましたらご鞭撻の程宜しくお願い致します。

cocoa

526 / 2272 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
1078194
(SS)C-BOARD v3.8 is Free