- ベストアンサー
複数のフォルダに、順次実行したいんですが？
papayukaの回答
- papayuka
- ベストアンサー率45% (1388/3066)
#2です。 > .Execute(msoSortByFileName) > 本来は、これでいいはずなんです。 Executeメソッドにソート用の引数があったのですね。 あまり使わないので知りませんでした。 勉強になりました。m(__)m > VBAを良く知っている人たちは、FileSearch すら、使わないという風潮があります。 私も Windows2000 + Office97で FileSearch がまともに機能せず、苦労した経験から、それ以降あまり使用してません。 http://support.microsoft.com/kb/259738/JA/ 良く考えたら先の回答もサブフォルダ内に複数ファイルが存在する場合を想定していませんでした。 結局順番通りに実行するには何らかの対処が必要ですね。
関連する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製品