- ベストアンサー
複数のフォルダに、順次実行したいんですが？
下記コードで（あるサイトにありました）、"C:\DATA"の中の複数のフォルダ（F1、F2、F3、変動あり、いまのところ3つまでです）へ、順次実行したいのですが、うまく出来ません。 Call を使用すれば、出来ますが、Call を使用しないで実行するにはどのように編集すればよろしいですか？ 以上よろしくご教示くださいませ。 中部分は、省略しました。 ---------- Sub CSVtoXLS() Dim myFS As FileSearch Dim mySvWb As Workbook Dim i As Long ChDir "C:\DATA" Set myFS = Application.FileSearch With myFS .LookIn = "C:\DATA" .Filename = "*.csv" If .Execute > 0 Then '保存用ブックを追加 Workbooks.Add Set mySvWb = Workbooks(2) For i = 1 To .FoundFiles.Count '見つかったファイルを一つずつ開く ・ ・ '保存用ブックを保存して閉じる mySvWb.SaveAs Filename:="CSV_hozon" mySvWb.Close Else '検索結果が０なら MsgBox "検索条件を満たすファイルはありません。" End If End With End Sub
- oshietecho-dai
- お礼率79% (263/330)
- オフィス系ソフト
- 回答数7
- ありがとう数4
- みんなの回答 （7）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (6)
- papayuka
- ベストアンサー率45% (1388/3066)
- Wendy02
- ベストアンサー率57% (3570/6232)
Wendy02です。 #5 の papayukaさんの >普通にやったのでは希望順にはならないと思います。 （名前順なら) .Execute(msoSortByFileName) 本来は、これでいいはずなんです。今、XP側+Office 2003では、問題は発生しませんが、この FileSearch というのは、確か、OutLook などと共有ツールで、これが、ひどく脆弱で、思ったように使えないというのが、実情なんです。配列やシートに書き出す、というのが、今は、一般的になっています。また、ある人は、FileSearchは、時間が掛かるという理由を挙げる人がいます。 だから、VBAを良く知っている人たちは、FileSearch すら、使わないという風潮があります。 別のところで書かなかった返事でもあるのですが、ExcelやOffice ネイティブ・メソッドというのは、いまひとつ信頼の置けないものがある、ということです。理屈ではなくて、経験なんですね。
補足
忘れてました。 前回答（NO.4） ＞そちらでは、新しいブックは、正しくオブジェクト変数に入っているのでしょうか？ book1,book2,book3,…となります。 これでは、あまりよくないのですね！
- papayuka
- ベストアンサー率45% (1388/3066)
#2です。 > 必ず、希望順で書き込ませたい場合の条件ですが、 抽出結果をシートに書き出して見ましょう。 FileSearch がどんな規則で Fileを抽出するか解りませんが、普通にやったのでは希望順にはならないと思います。 配列やシートで一旦受けてソート後にそのリストを元に実行するなど、何らかの工夫が必要だと思いますが、これまでの経緯から、失礼ながら現在の貴殿の技量では改修は無理だと思います。 ちなみに #4さんが指摘されているように Set mySvWb = Workbooks(2) は危ういコードです。 おそらく、ThisWorkbookが Workbooks(1) の環境だと Workbooks.Add で 作られたブックが Workbooks(2) になると言う事なのでしょう。 でも個人用マクロブックを利用している場合の Workbooks(2) は Thisworkbook になるなど、実行する環境で Workbooks(2)は異なります。 Workbooks.Add Set mySvWb = Workbooks(2) ここの2行は Set mySvWb = Workbooks.Add とする方が恐らく問題が少ないと思われます。 Call なら可能と言うのは、"C:\DATA" の部分を書換えた Sub CSVtoXLS を複数用意し、それを順次実行する Sub を作る事を意味するものと推測しています。 ちょっと泥臭いですが、CSVtoXLS を ※ のように書換えてから Sub CSVtoXLS(myFolder as String) '※ Dim myFS As FileSearch Dim mySvWb As Workbook Dim i As Long ChDir myFolder '※ Set myFS = Application.FileSearch With myFS .LookIn = myFolder '※ ・ ・ ・ '------------------------------------------------ Sub aaa() Call CSVtoXLS("C:\DATA\F1") Call CSVtoXLS("C:\DATA\F2") Call CSVtoXLS("C:\DATA\F3") End Sub のような感じにしたら如何でしょう？（未確認） 何でも「ボタンひとつで」を目指しているは結構ですが、寄せ集めで意味もまったく解らず、自分で簡単なメンテナンスも出来ないようでは業務では怖くて使い物にならないと感じます。 少しはコードの意味を理解出来るように学習する方が先決だと思います。
お礼
ご回答どうも有難うございます。 はい、おっしゃられる通りでございます。 ただ、ご指示された通り、普通に実行（サブフォルダ内に複数ファイル、"cmd*"の「*」が1,2,3,…）してみましたが、希望順通り（エクスプローラ画面の、名前順の通り）に書き込まれてます。（まだ多くは試みてはいませんが、同ファイルなら何度か試みました） ですので、いったいぜんたい、どんな時に、順番違いになるのかが知りたかったわけございます。 ご指示された通り、「問題が少ない」方法をとりたいと思います。
- Wendy02
- ベストアンサー率57% (3570/6232)
こんばんは。 すでに解答としては出ていますが、 With myFS の下に、 .SearchSubFolders = True を加えることとですが、 >Call を使用すれば、出来ますが、 本当にそうですか？ このコードは、そんなに癖の強いものではありませんので、あえて書かせていただきます。 コードの一部が隠されているので見当が付かない部分がありますが、 Workbooks.Add Set mySvWb = Workbooks(2) ここの部分が分かりません。少し、ここが雑です。今、コードを動かしみると、Workbooks(2) は、自ブック(ThisWorkbook)になっていました。本来、こういう場面で、Index は使ってはいけないのですね。 Workbooks.Add をしておいて、違うブックの変数を取るというのは、良く理解できないコードです。 そちらでは、新しいブックは、正しくオブジェクト変数に入っているのでしょうか？ それに、その後もヘンです。たぶん省略してあるせいだと思いますが、 >検索結果が０なら >MsgBox "検索条件を満たすファイルはありません。" いきなり、そこに結びついても、上には、その判断する条件構文がありませんから、奇妙に感じます。 FileSearch を使って、Call で問題ないとおっしゃるなら、それ以上は、こちらは何も言えません。
お礼
遅くなり申し訳ございません。 どうも有難うございます。 けっこうコードが長かったものですから、省略してしまいました。 実行の度に、新しいブックが追加されていきます。 ご指摘された部分は、 今後、学習していきたいと思います。
- NCU
- ベストアンサー率10% (32/318)
- KenKen_SP
- ベストアンサー率62% (785/1258)
> Call を使用すれば、出来ますが、Call を使用しないで実行するには > どのように編集すればよろしいですか？ Call を使えばできるなら、それで良いのでは？ なぜ既にできているのに、Call を使わないで実行する必要があるのですか？ ご質問の趣旨はどこにあるのでしょうか？
補足
どうも有難うございます。 うまく説明できなかったかも知れませんが、当Call は、 当マクロを丸々3つ作成し、Call するということでございます。 （No.5で推測されてしまっておりました） なんとなく、重くなるような気がしたためでございます。
関連するQ&A
- ワイルドカードの記述が、原因でしょうか？
下記コードが、ついこの前までは、きちんと "A?07??????.CSV" を読み込んでたんですが、 今は、 "検索条件を満たすファイルはありません。" となってしまいます。 １、ワイルドカードの記述が、おかしいでしょうか？ ２、フォルダ名は、漢字等はやめて、半角英数字にしたほうがよいのでしょうか？ ３、このような、現象は、よくあることでしょうか？ 以上 原因がわかりませんので、何卒ご教示くださいませ。 ----------------- Private Sub TEST() Dim myFS As FileSearch Dim i As Long ChDir "C:\Documents and Settings\Owner\デスクトップ\ああ" Set myFS = Application.FileSearch With myFS .LookIn = "C:\Documents and Settings\Owner\デスクトップ\ああ" .Filename = "A?07??????.CSV" If .Execute > 0 Then For i = 1 To .FoundFiles.Count '見つかったファイルを一つずつ開く Workbooks.OpenText Filename:=.FoundFiles(i), _ StartRow:=1, _ DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, _ Comma:=True 'ああ.xlsブックに移動 Sheets(1).Move after:=Workbooks("ああ.xls").Worksheets(Workbooks("ああ.xls").Sheets.Count) Next i Else MsgBox "検索条件を満たすファイルはありません。" End If End With End Sub
- ベストアンサー
- オフィス系ソフト
- Excel'97で 実行時エラー '1004' が出る
毎日更新されるCSVファイルがあります。 このファイルをExcelに変換して、他のファイルにリンクしています。 CSVファイルを開かなくても、データを更新できるよう、マクロを組みました。 Excel2000では、問題なく動くのですが、’97で実行すると、 実行時エラー '1004': アプリケーション定義またはオブジェクト定義のエラーと出てしまいます。 メインに使っているPCが'97なので、 色々調べてみたのですが、私の知識ではわからず、困っています。 詳しい方がいらっしゃれば、教えて頂きたく思います。 コードは以下のようなものです。 Private Sub Workbook_Open() Dim Workbooks As Variant Dim Sheets As Variant Dim Filename As Variant Dim wR As Long ThisWorkbook.Sheets("Sheet1").Activate Cells.ClearContents Filename = Application.GetOpenFilename("CSV ファイル(*.csv),*.csv") ここで、デバック ↓ With ActiveSheet.QueryTables.Add _ (Connection:="TEXT;" & Filename, Destination:=Range("A1")) .TextFileCommaDelimiter = True さらにここでも、デバック(実行時エラー1004 外部データ範囲を 更新するためのテキスト ファイルが見つかりません) ↓ .Refresh BackgroundQuery:=False End With With ActiveSheet .Columns("B:C").Delete shift:=xlToLeft '(CSVファイルのA,B列は不要のため、削除） wR = .Range("B" & Rows.Count).End(xlUp).Row .Range("A1") = "=B1&C1&D1" .Range("A1").AutoFill Destination:=Range("A1:A" &wR), Type:=xlFillDefault End With End Sub
- ベストアンサー
- オフィス系ソフト
- VBA 実行時エラー 424 の表示が出る
下記のVBAを作成していてエラーが出てしまいます 8行目でオブジェクトが必要ですと表示が出るのはなぜでしょうか？ やりたいこととしてはボタンを選択すると特定のシート[ADDR_TO]を 同一階層上に[ADDR_TO]のファイル名でCSVとして保存することです ---- Private Sub CommandButton2_Click() Dim strNewBookName As String strNewBookName = "ADDR_TO" Workbooks.Add.SaveAs Filename:=ThisWorkbook.Path & "\" & strNewBookName, FileFormat:=xlCSV SheetCSV.Cells.Copy With Workbooks(strNewBookName & ".csv") .Worksheets(strNewBookName).Range("A1").PasteSpecial Paste:=xlPasteAll .Worksheets(strNewBookName).Range("A1").Select .Save .Close End With Call MsgBox("出力完了", vbInformation) End Sub
- ベストアンサー
- Visual Basic
- VBA：2つのCSVファイルを開きたいです。
エクセル2010のVBAにてCSVファイルを開き結合させるプログラムを組もうとしているのですが、2つ目のCSVファイルを開こうとすると、何故かエラーが出てしまいます。 -------------------------------------------------------------------------------- 1つ目 Sub mobile_FileSearch(Path As String) 'test.csvのデータを検索して開く Dim FSO As Object, Folder As Variant, File As Variant Set FSO = CreateObject("Scripting.FileSystemObject") For Each Folder In FSO.GetFolder(Path).SubFolders Call mobile_FileSearch(Folder.Path) Next Folder For Each File In FSO.GetFolder(Path).Files If File.Name = "test.csv" Then Workbooks.Open ("test.csv") End If Next File End Sub ---------------------------------------------------------------------------- 2つ目 Sub local_FileSearch(Path As String) 'bbb.csvのデータを検索して開く Dim FSO As Object, Folder As Variant, File As Variant Set FSO = CreateObject("Scripting.FileSystemObject") For Each Folder In FSO.GetFolder(Path).SubFolders Call local_FileSearch(Folder.Path) Next Folder For Each File In FSO.GetFolder(Path).Files If File.Name = "bbb.csv" Then Workbooks.Open ("bbb.csv")'←ここでエラー End If Next File End Sub ------------------------------------------------------------------------ まったく同じプログラムで、csvファイル名だけ変えただけで実行時エラー1004が出てしまいます。 一体全体何が問題なのでしょうか？
- ベストアンサー
- その他（プログラミング・開発）
- エクセルVBAの変数利用
シートのC1セルに入力したブック名をアクティブにするための 変数なのですが、アクティブになりません。 下のようにしていますが、とのようにすればよいでしょうか？ Sub test() Dim FileName As Range FileName = ThisWorkbook.Path & "\" & Sheets("sheet1").Range("C1") & ".xls" Workbooks.FileName.Activate End Sub
- ベストアンサー
- オフィス系ソフト
- FileSearchが使えなくなり困ってます。
仕事場で前任者が下記のようなマクロを組んでいたのですが、「FileSearch」が使用できなくなり、なおさなくてはいけなくて困ってます。 指定の保存先から、アクティブセルと同じ保存名のファイル（エクセル）を開く内容なのですが、お分かりになるかた知恵を拝借願いますでしょうか？ 素人なので、できれば専門用語じゃない回答をいただけるとありがたいです。 よろしくお願い致します。 Dim p As Range For Each p In Selection If p = "" Then Exit Sub End If With Application.FileSearch .Filename = p .LookIn = "保存先" .SearchSubFolders = True .LastModified = msoLastModifiedAnyTime .FileType = msoFileTypeExcelWorkbooks .SearchSubFolders = xt .Execute For Each f In .FoundFiles Workbooks.Open f Next f End With Next p End Sub
- ベストアンサー
- Visual Basic
- このコードのチェックをお願い致します。
2種類のブックのデータを → 追加した１つのブックに貼り付けます。 下記 「'------ここからエラーになる----」 からエラーになります。 エラー番号 91 「オブジェクト変数またはWith ブロック変数が設定されていません」 以上 下記コードのチェックをお願い致します。 ------------------------------ Sub tes1() Dim fWord As String, fAdd, c, wb As Workbook fWord = "1" Set wb = Workbooks.Add(xlWBATWorksheet) Workbooks("ああ.CSV").Activate Rows("1:1").Select Selection.Insert Shift:=xlDown With Workbooks("ああ.CSV").Worksheets(1).Range("F:F") Set c = .Find(fWord, LookIn:=xlValues) If Not c Is Nothing Then fAdd = c.Address Do c.Offset(0, 2).Resize(8, 1).Copy wb.Worksheets(1).Range("B65536").End(xlUp). _ Offset(1, 0).PasteSpecial Paste:=xlAll, _ Transpose:=True Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> fAdd End If End With Application.CutCopyMode = False Call tes2 End Sub '-------------------- Sub tes2() Dim aWord As String, aAdd, c, wb As Workbook aWord = "1" Workbooks("いい.CSV").Activate With Workbooks("いい.CSV").Worksheets(1).Range("A:A") Set c = .Find(aWord, LookIn:=xlValues) If Not c Is Nothing Then aAdd = c.Address Do c.Offset(0, 23).Resize(1, 1).Copy '------ここからエラーになる------------------------ wb.Worksheets(1).Range("B65536").End(xlUp). _ Offset(1, 0).PasteSpecial Paste:=xlAll, _ Transpose:=True Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> aAdd End If End With Application.CutCopyMode = False End Sub
- ベストアンサー
- オフィス系ソフト
- ファイルサーバーからローカルフォルダーに移動したい
下記のVBAはローカル環境でデータを同じフォルダーにCSVとして吐き出す事を目的に調べながら作ったのですが、運用の関係上ファイルサーバーへ置く事になってしまいローカルの「ダウンロード」フォルダーにに吐き出せないか色々試してみているのですが、どうしても分かりません。お知恵をいただければ幸いです。 宜しくお願い致します。 '現在開いているシートをCSVデータで保存する Public Sub call_RangeSaveCSV() Dim fPath As String Dim fName As String Dim rng As Range '現在開いているブック情報をファイル名にするため、変数に格納 fPath = ActiveWorkbook.Path & "\" fName = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".")) & "csv" Application.DisplayAlerts = False '現在選択しているセル情報をrngに格納 Set rng = Selection '新規ブック作成→rngをA1にコピー→CSV保存→CSV閉じる Workbooks.Add rng.Copy ActiveSheet.Range("A1") ActiveWorkbook.SaveAs Filename:=fPath & fName, FileFormat:=xlCSV ActiveWindow.Close Application.DisplayAlerts = True End Sub
- ベストアンサー
- Excel（エクセル）
- ファイル名のわからない複数のファイルをひとつにまとめる
エクセル2000で以下のマクロを作成したいです。 １．フォルダ内のCSVファイルを開き、中のデータをひとつにまとめる。 （フォルダ名とファイル名、ファイル数はその時によって変わってきます。ファイル数はだいたい10個くらいです。ひとつのデータは20列50行くらいで列の項目を基準にまとめたいです。） ２．列を1列目に挿入し、2列目と3列目のデータを1列目に統合する。 ３．1列目のデータを使用し、重複を調べる。重複がある場合はどちらかひとつを削除する。（できれば4列目のデータを比較し数値が少ないほうを削除したいです。） まだ途中までですが、マクロ作成してみました。 わたしとしては、フォルダ内のCSVファイルを開いてセルA1からデータの入った範囲をコピーし、testエクセルファイルのアクティブセルに貼り付け ↓↓↓ 次のファイルのデータをその下に貼り付けたいのでtestファイルのデータが入ったセルの下を選択し、ファイルを開くへ繰り返し。 のつもりなのですが…、うまく作動しません。 マクロのテキストを片手にネットでも検索しながら作ったのですが、まだ記述の仕方などがわかってなくどこがおかしいのかもわかりません。 わかる方がいたらよろしくお願いします！ ----------------------------------- Sub ファイルのデータを統合() Dim filename As String Dim openedbook As Workbook Dim isbookopen As Boolean Dim myworksheet As Worksheets Dim myrange As Range filename = Dir(ThisWorkbook.Path & "\*.csv") Do While filename <> "" isbookopen = False For Each openedbook In Workbooks If openedbook.Name = filename Then isbookopen = True Exit For End If Next Range("A1").CurrentRegion.Copy Destination:=Workbooks("test.xls").Worksheets("sheet1").ActiveCell Workbooks("test.xls").Worksheets("sheet1").Range("A1").End(xlDown).Offset(1).Select If isbookopen = False Then Workbooks.Open (ThisWorkbook.Path & "\" & filename) End If filename = Dir() Loop End Sub
- ベストアンサー
- Visual Basic
- エクセルの列削除がうまくいかない。
CSV変換データの不要な列を削除しようとしているのですが、思うような動作しません。 CSV変換マクロを起動と同時にA,B,E,F,O,P,Q,R列を削除しようとしているのですが、うまくいかない。 教えていただけないでしょうか。 添付データは元のファイルです。 Option Explicit Sub EasyCopyCSV() Dim CSV_filename As Variant, target As Variant Dim CSV_SheetName As Variant Dim FileCount As Long Dim kk As Long CSV_filename = Application.GetOpenFilename(filefilter:="CSVファイル(*.csv;*.prn),*.csv;*.prn", MultiSelect:=True) If IsArray(CSV_filename) Then Else MsgBox "キャンセルされました" Exit Sub End If FileCount = UBound(CSV_filename) '配列のサイズからファイル数を調べる For kk = 1 To FileCount 'ファイル数カウンタ初期化しファイル数分カウンタを回す Workbooks.Open CSV_filename(kk) 'ファイルを開く CSV_SheetName = Worksheets(1).Name '開いたシートの名前=ファイル名を取得 Sheets(CSV_SheetName).Move Before:=ThisWorkbook.Sheets(1) Next '不要列を削除 With ActiveSheet .Range(.Columns(1), .Columns(2)).Delete Shift:=xlShiftToLeft .Range(.Columns(5), .Columns(6)).Delete Shift:=xlShiftToLeft .Range(.Columns(15), .Columns(18)).Delete Shift:=xlShiftToLeft End With End Sub
- ベストアンサー
- その他MS Office製品
補足
誠に、どうも有難うございました。 何とかヘルプにて、実行することができました。 「書き込まれる順序について」、1つだけ、お願い致します。 必ず、希望順で書き込ませたい場合の条件ですが、 各フォルダ名、各ファイル名、の "cmd*" "*cmd" の「*」が、 1,2,3,… A,B,C,… a,b,c,… あ、い、う、… なら、この順序で書き込まれるわけでしょうか？ よろしくお願い致します。