VBからエクセルファイルを読込み、エクセル内の文字を検索したい
解決VBを利用して、あるフォルダ内のエクセルファイルを検索しファイルを読込み、その読込んだエクセルファイル内のA列を検索した、その結果を表示したいのですが、どの様なソースにしたら良いのか全くわからないので、どなたか教えていただけにでしょうか？よろしくお願いします。
1.フォルダ内のエクセルファイルを検索する。(任意の文字を入力し検索する)
2.検索完了したらファイルを読込む。(エクセルは起動しない)
3.読込んだエクセルファイルの内A列を検索する。（任意の文字を入力し検索する）
4.検索結果を表示する。（A列、B列、C列を表示）
環境は、VB6.0 エクセル2003です。 Win XP Pro
掲示板で１から教えるのは量的に無理ですから、基礎を学んでくる
ことをお勧めします。
[VBレスキュー(花ちゃん)Ｅｘｃｅｌ・Ｗｏｒｄ関係]
http://www.bcap.co.jp/hanafusa/VBHLP/excelframe.htm
その後で過去ログ
http://madia.world.coocan.jp/cgi-bin/VBBBS2/wwwlng.cgi?print+200406/04060060.txt
2週間かかり下記ソースができました。
マイドキュメント内のエクセルファイルが開くようになりました。
しかし、あるサーバー内のあるフォルダの中のファイルを検索したいのですが、パスを指定する箇所がわかりません。
また、利用したいフォルダ内にはいくつかフォルダがあり階層にもなっているのでそれも検索できるようにしたいのです。
エクセル内をFindメソッドとRangeを利用して、A列(A1：A10)を検索できるようになり、MsgBoxに検索結果を表示できるようになったのですが、検索結果としてB列やC列もMsgBoxに表示できるようにしたいのですが、どなたかアドバイスをよろしくお願いします。
Private Sub Command1_Click()
On Error Resume Next
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlInput As String
' Inputでファイルを任意のファイル名を検索し
'見つかったらファイルを開く
xlInput = InputBox("機種")
Set xlApp = CreateObject("Excel.Application") 'エクセル起動
Set xlBook = xlApp.Workbooks.Open(xlInput)
'試し：正常に指定したファイルが開いているか確認するため xlApp.Visible = True
Dim myRange As Range
Dim xlFind As String
xlFind = InputBox("部番")
Set myRange = Worksheets("Sheet1").Range("A1:A10")
answer = Application.WorksheetFunction.Find(Sheet1, "A1:A10", xlFind)
MsgBox answer
If vbOKOnly = 0 Then xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
お、すごい♪
とりあえず
>サーバー内のあるフォルダ
ってのが初耳なんで、ちょっと確認。ローカルのフォルダではなく、
外部のコンピュータを覗く場合、セキュリティ関係の問題が出てくる
場合があります。その辺りの話はネットワーク管理者の方とよく確認
しておいて下さい。今後とも、マイクロソフトはセキュリティ面を強化
していくと思われますので、そちらのお勉強も必要になるかもしれません。
ま、今のところ、対象フォルダの参照権限を持ってれば(エクスプローラ
で対象フォルダを閲覧できていれば)大丈夫でしょう。
>しかし、あるサーバー内のあるフォルダの中のファイルを検索したいのですが、パスを指定する箇所がわかりません。
昨日、似たような質問がありました。自分以外の質問にも関連しそうな質問には
目を通しておきましょう。
http://madia.world.coocan.jp/cgi-bin/VBBBS2/wwwlng.cgi?print+200508/05080020.txt
こちらの方はネットワークドライブを割り当てて、ローカルのフォルダと同じ様な
処理をされたようです。
基本的にネットワーク越しのアドレスは
\\コンピュータ名\ドライブ名\フォルダ名\ファイル名
という形式で扱えます。
>利用したいフォルダ内にはいくつかフォルダがあり階層にもなっているので
>それも検索できるようにしたいのです。
これはよくあるサンプルですね。色々な場面で使えますのでサンプルを
公開している方は多いでしょう。今回はじゃんぬさんのページをリンク
させて貰いましょうか。感謝です♪
[ディレクトリ (フォルダ) 以下のファイルを最下層まで検索または取得する]
http://jeanne.wankuma.com/tips/directory/15-getallfiles.html
リンク先の一番下が[VB6.0]のコードです。
>検索結果としてB列やC列もMsgBoxに表示できるようにしたいのですが
Range の指定時に列も指定すれば簡単に実現できますね。
変数の接頭詞の xl はエクセルの定数で使われているので使わないほうが
いいです。ボクはローカル変数は work の意味で w を付けてます。
(モジュールレベル変数は m)
あと、入力エラーチェックがありませんね。ファイルが存在しなかった時など
標準のエラー処理に任せず、自分でチェックするようにしましょう。
[VB6.0]
Dim wMyRange As Range
Dim wAnswerRange As Range
Dim wColAlphabet As String
Dim wFindAddress As String
Dim wFindString As String
Dim wFirstAddress As String
wColAlphabet = InputBox("検索する列名をアルファベットで入力して下さい。")
'ここで入力エラーチェックするべきです。
wFindAddress = wColAlphabet & "1:" & wColAlphabet & "10"
wFindString = InputBox("部番")
Set wMyRange = Worksheets("Sheet1").Range(wFindAddress)
' answer = Application.WorksheetFunction.Find("Sheet1", wFindAddress, wFindString)
With wMyRange
Set wAnswerRange = .Find(wFindString, lookin:=Excel.XlFindLookIn.xlValues)
If Not wAnswerRange Is Nothing Then
wFirstAddress = wAnswerRange.Address
MsgBox wFirstAddress
Do
Set wAnswerRange = .FindNext(wAnswerRange)
If Not wAnswerRange Is Nothing And wAnswerRange.Address <> wFirstAddress Then
MsgBox wAnswerRange.Address
Else
Exit Do
End If
Loop 'While Not wAnswerRange Is Nothing And wAnswerRange.Address <> wFirstAddress
Else
MsgBox "見つかりませんでした。"
End If
End With
あ"っ、[VB6.0]のサンプルで
> Set wMyRange = Worksheets("Sheet1").Range(wFindAddress)
はマズいねぇ。
Set wMyRange = xlBook.Worksheets("Sheet1").Range(wFindAddress)
かな？なんか提示されたコードがＶＢＡのコードと混ざってる気が…(＾＾；)
>サーバー内のあるフォルダ
に関しては、自部署のサーバー内を検索する予定であったことを思い出したので・・・改めて追記しました。
>しかし、あるサーバー内のあるフォルダの中のファイルを検索したいのですが、パスを指定する箇所がわかりません。
に関しては、パスを指定する箇所がわかりませんでした。
>利用したいフォルダ内にはいくつかフォルダがあり階層にもなっているので
>それも検索できるようにしたいのです。
リンクして頂いたサンプルコードを利用して、検索可能になりました。またパスの指定箇所もわかりました。
>検索結果としてB列やC列もMsgBoxに表示できるようにしたいのですが
この件なのですが、特攻隊長まるるうさんにサンプルコードを提示して頂いた内容丸々そのまま入れさせてもらい、そこから色々いじって理解してきました。（下記のようになりました。）
どうしてもMsgBoxに表示させる内容が、うまくいきません。Rangeの使用方法を調べては見たのですが下記点がうまくできません。
●B列を検索し、抽出できた内容がどの位置にあるかAdrress表示していることがわかりましたが、そのときのA列やC列も同時にMsgBoxに表示しようとヘルプでRangeの使い方を調べながらやっているのですがうまくいきません。
（Findの検索結果をRangeの引数に代入したらよいのか困ってます。）
例えばAdrressで$B$3と表示されるとき、A3,B3.C3も表示したいのですが・・・
教えていただきたいのですがよろしくお願いします。
Dim lIndex As Long
Dim nPrompt As String
Dim nFilePath As String
Dim nFilePathes() As String
Dim strFile As String
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
' InputBoxで検索したいファイル名を入力し、エクセルファイルを最下層まで検索し取得する
strFile = "NTL302M"
'strFile = InputBox("機種")
nFilePathes() = GetFilesMostDeep("D:\VB\", "" & strFile & ".xls")
' 取得したファイル名を列挙する (※ 添字が 1 からであることに注意)
For lIndex = 1 To UBound(nFilePathes())
nPrompt = nPrompt & nFilePathes(lIndex) & vbNewLine
Next lIndex
' 取得したすべてのファイルパス(機種ファイル)を表示する【確認】
If nPrompt <> "" Then
Call MsgBox(nPrompt)
End If
'取得したパス(ファイル)を開く
For lIndex = 1 To UBound(nFilePathes())
nPrompt = nPrompt & nFilePathes(lIndex) & vbNewLine
Set xlApp = CreateObject("Excel.Application") 'エクセル起動
Set xlBook = xlApp.Workbooks.Open(nFilePathes(lIndex)) '開くファイルパスをOpenメソッドに代入
'xlApp.Visible = True
Next lIndex
'開いたファイル内を検索
Dim wMyRange As Range
Dim wAnswerRange As Range
Dim wColAlphabet As String
Dim wFindAddress As String
Dim wFindString As String
Dim wFirstAddress As String
'wColAlphabet = InputBox("検索する列名をアルファベットで入力して下さい。")
wColAlphabet = "B" '部番で設定
'ここで入力エラーチェックするべきです。
wFindAddress = wColAlphabet & "1:" & wColAlphabet & "10000"
wFindString = "0002"
'wFindString = InputBox("部番")
Set wMyRange = xlBook.Worksheets("Sheet1").Range(wFindAddress)
' answer = Application.WorksheetFunction.Find("Sheet1", wFindAddress, wFindString)
With wMyRange
Set wAnswerRange = .Find(wFindString, lookin:=Excel.XlFindLookIn.xlValues)
If Not wAnswerRange Is Nothing Then
'wFirstAddress = wAnswerRange.Address
wFirstAddress = wAnswerRange
MsgBox wFirstAddress
Do
Set wAnswerRange = .FindNext(wAnswerRange)
'If Not wAnswerRange Is Nothing And wAnswerRange.Address <> wFirstAddress Then
If Not wAnswerRange Is Nothing And wAnswerRange <> wFirstAddress Then
MsgBox wAnswerRange
Else
Exit Do
End If
Loop 'While Not wAnswerRange Is Nothing And wAnswerRange.Address <> wFirstAddress
Else
MsgBox "見つかりませんでした。"
End If
End With
' Quit メソッドを使って Excel を終了します。
xlApp.Quit
' オブジェクトを解放します。
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
> '取得したパス(ファイル)を開く
> For lIndex = 1 To UBound(nFilePathes())
> nPrompt = nPrompt & nFilePathes(lIndex) & vbNewLine
> Set xlApp = CreateObject("Excel.Application") 'エクセル起動
> Set xlBook = xlApp.Workbooks.Open(nFilePathes(lIndex))
> 'xlApp.Visible = True
> Next lIndex
上記の部分が気になります。
ループ中で、Excel.Applicationインスタンスを随時生成していますが、
それを受け取る変数が、xlApp一つしか用意されていませんよね。
Excel.Applicationのインスタンスを複数扱うのであれば、
For n = LBound(X) To UBound(X)
Set xlApp(n) = CreateObject("Excel.Application")
Set xlBook(n) = xlApp(n).Workbooks.Open( X(n) )
Next n
のようにして、それを受け取るための変数も、(配列などを使って)
用意するべきですし、逆に、インスタンスを1つだけにしたいなら
Set xlApp = CreateObject("Excel.Application")
For n = LBound(X) To UBound(X)
Set xlBook(n) = xlApp.Workbooks.Open( X(n) )
Next n
のように、ループの外に出すべきかと思いますよ。
あるいは、ワークブックを受け取る変数も1つだけにするために、
Set xlApp = CreateObject("Excel.Application")
For n = LBound(X) To UBound(X)
Set xlBook = xlApp(n).Workbooks.Open( X(n) )
'(xlBookに対する検索処理)
xlBook.Close
Set xlBook = Nothing
Next n
xlApp.Quit
Set xlApp = Nothing
のように、検索部分もループの中に含めるようにするとか。
魔界の仮面弁士さんありがとうございます。
確かにループ内で随時生成されている状態でした。
さっそく修正してみました。
勉強になました。m(__)m
>例えばAdrressで$B$3と表示されるとき、A3,B3.C3も表示したいのですが・・・
Excel VBA のヘルプで Cells プロパティのサンプルに『セルの値が 1 つ上の
セルの値と同じ場合』の比較をしているサンプルコードが載っていると思います。
…普通に Range コレクションの説明を上から順に読んでいけば辿り着けそう
なんですが…(＾＾；)…初心者にはピンとこないものなんですねぇ。
・範囲の指定→Range
・セルの指定→Cells
けっこう英単語の和訳そのままですので、プロパティ名からどんな動作を
するか？予想できる訓練をしておいて下さい。
…あ。
> 'wFirstAddress = wAnswerRange.Address
> wFirstAddress = wAnswerRange
wFirstAddress はループの終了判定↓で利用してますので
> 'If Not wAnswerRange Is Nothing And wAnswerRange.Address <> wFirstAddress Then
> If Not wAnswerRange Is Nothing And wAnswerRange <> wFirstAddress Then
このままでは誤動作を引き起こします。
勝手な改造での誤動作の文句は受け付けませんのであしからず
ご了承下さい。
ループの箇所は、どんな動きをしているのか確かめ、コードの役割を確認し
ていました。
確かに、指摘の箇所で誤動作しておりました。
元に戻しました。
特攻隊長まるるうさんのおかげで、やっと自分のやりたかった内容が完成し
無事問題なく使用できるようになりました。ありがとうございました。
まだVBを使ってやらなきゃならないこともあるので、さらに勉強して活用し
たいです。
| ツイート |  |