Access VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

100 / 500 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【11293】Re:フォームをクエリのフィルタを使って...

koppe

- 09/12/12(土) 9:51 -


	引用なし

	パスワード

▼cocoa さん：
>▼koppeさん
>And学科が怪しいような。
小僧さんcocoaさんありがとうございました
Andと学科の間に半角スペースを入れたら解決しました。
VBAはしびやですね、本当に助かりました。

・ツリー全体表示


	【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

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

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

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

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

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

・ツリー全体表示


	【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関数の勉強をさせていただきます。
ありがとうございます。

・ツリー全体表示


	【11290】Re:ｺﾏﾝﾄﾞﾎﾞﾀﾝを押下すると、指定ﾌｧﾙﾀﾞ下...

cocoa - 09/12/11(金) 11:46 -


	引用なし

	パスワード

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

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

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

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

・ツリー全体表示


	【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, """", ""), ",")

・ツリー全体表示


	【11288】Re:フォームをクエリのフィルタを使って...

cocoa - 09/12/11(金) 10:32 -


	引用なし

	パスワード

▼koppeさん
And学科が怪しいような。

・ツリー全体表示


	【11287】Re:フォームをクエリのフィルタを使って...

koppe

- 09/12/11(金) 8:08 -


	引用なし

	パスワード

ありがとうございました。解決いたしました。
ACCESSの初心者なのでいろいろ教えてください。
2個の条件を設定して平均値を求めるＶＢＡの式ですが
テキスト1とテキスト2に条件を入力して、コマンドボタン3をクリックすると、結果をテキスト3にかえす。

Private Sub コマンド3_Click()

If IsNull(Me!テキスト1) Then

Me!テキスト3 = DAvg("点数","名簿")

Else

Me!テキスト3 =Davg("点数","名簿", "氏名='" & Me!テキスト1 & "' And 学科='" &Me!テキスト2 & "'")
End If
End Sub

訳ですが、どうしても構文エラーになります。
エラー文章
　エラーコメント　
実行時エラー　３０７５
クエリ式　氏名＝山本太郎,　And学科＝国語の構文エラー
演算子がありません。

こんなエラーになります、どこが間違っているのでしょうか
出来ましたら、ＶＢＡの修正コードを書いて教えてもらえないじょうか。
よろしくお願いいたします。

・ツリー全体表示


	【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
ここからが実データになります。

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

宜しくお願い致します。

・ツリー全体表示


	【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データは文字列になるのでしょうか？

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

・ツリー全体表示


	【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テーブルへインポートされました。

しかしインポートされたデータが""で囲まれてしまったのです。
例:フィールド１　フィールド２　フィールド３・・・
　 "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 の部分が違うからでしょうか？

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

・ツリー全体表示


	【11283】Re:ｺﾏﾝﾄﾞﾎﾞﾀﾝを押下すると、指定ﾌｧﾙﾀﾞ下...

cocoa - 09/12/10(木) 13:17 -


	引用なし

	パスワード

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

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

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

・ツリー全体表示


	【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 メソッドにて同期処理が取れるので
変更を加えてあります。

・ツリー全体表示


	【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

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

宜しくお願い致します。

・ツリー全体表示


	【11280】Re:フォームをクエリのフィルタを使って...

小僧 - 09/12/10(木) 9:57 -


	引用なし

	パスワード

▼koppe さん：
こんにちは。

>下のＶＢＡだとエラーになります。

どのようなエラーが出ているのでしょうか。
こちらの掲示板に写した時のタイプミスでなければ
いくつかスペースが欠けていますね。

> >Me!テキスト0 = DAvg("点数", "名簿","氏名='"&Me!氏名&"'")

Me!テキスト0 = DAvg("点数", "名簿", "氏名='" & Me!氏名 & "'")

・ツリー全体表示


	【11279】Re:ｺﾏﾝﾄﾞﾎﾞﾀﾝを押下すると、指定ﾌｧﾙﾀﾞ下...

小僧 - 09/12/10(木) 9:45 -


	引用なし

	パスワード

▼cocoa さん：
こんにちは。

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

> If UBound(arrData) = -1 Then
↓
　If arrData(0) = " " Then

で判断できそうですね。

・ツリー全体表示


	【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関数のインデックスが間違っている。とエラーになると予想致しました。

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

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

・ツリー全体表示


	【11277】フォームをクエリのフィルタを使って開く...

koppe

- 09/12/9(水) 20:13 -


	引用なし

	パスワード

クエリ名　名簿
ID
氏名
点数
３つのフィールドがあります。
フォーム名　フォーム１
フォームのコマンドボタンをクリックすると、フォーム１を開く
ただし、氏名を選んでその人だけの平均の点数を抽出したいのですが
下のＶＢＡだとエラーになります。
何が間違っているのか教えてください。

Private Sub コマンド2_Click()

Me!テキスト0 = DAvg("点数", "名簿","氏名='"&Me!氏名&"'")

End Sub
氏名に１０人いたとして、そのうちの１人を抽出して、点数の平均値を求める
出来ましたら、ＶＢＡを直していただければ大変助かります
よろしくお願いいたします。

・ツリー全体表示


	【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 を貼ったかの情報がないと
こちらとしては何とも言えません…。

・ツリー全体表示


	【11275】Re:ｺﾏﾝﾄﾞﾎﾞﾀﾝを押下すると、指定ﾌｧﾙﾀﾞ下...

cocoa - 09/12/9(水) 14:05 -


	引用なし

	パスワード

▼小僧様　皆様
>最終行(271行目)は
>改行コードだけがあるのでしょうか…。
うまく説明できなくて申し訳ないです。
改行コードだけかどうかはわからないのですが、データはないです。
フィールド１　フィールド２　...フィールド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行目までのデータはインポートされておりました。が、インデックスエラーがでます。

宜しくお願い致します。

・ツリー全体表示


	【11274】Re:ｺﾏﾝﾄﾞﾎﾞﾀﾝを押下すると、指定ﾌｧﾙﾀﾞ下...

小僧 - 09/12/9(水) 11:09 -


	引用なし

	パスワード

▼cocoa さん：
こんにちは。

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

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

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

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

arrData = Split(txtData, ",")

の次行に

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

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

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

100 / 500 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free