EXcelマクロで同じフォルダ内のファイル全て開く方法

前へ 次へ
このQ&Aのポイント
  • EXcelマクロを使用して同じフォルダ内のすべてのファイルを開く方法について教えてください。
  • カレントフォルダが異なるドライブに設定されている場合に、EXcelマクロで同じフォルダ内のファイルを開く際に問題が発生します。この問題の解決方法はありますか？
  • 特定のフォルダ内のExcelファイルを自動的に開くマクロを作成したいです。どのようにすれば実現できますか？
回答を見る
  • ベストアンサー

EXcelマクロで同じフォルダ内のファイル全て開く。ドライブまたいでも対応

以前以下のVBAを教えていただいたham-kamoさんに質問があります。もちろん違う方でも構いません。 「同じフォルダ内のブックを開くマクロ」についてですが、以下のVBAだとカレントフォルダをオプションで違うドライブに設定しているとうまく動作しないのですが、解決法はありますでしょうか？ 例えば\\AAAA\BBというアドレスのフォルダ内にマクロを起動するファイルがあり、C:\Documents and Settings\XXXXがカレントフォルダに設定されるとC:\Documents and Settings\XXXX内のExcelファイルが開かれてしまうということです。 -------------------------- Sub OpenAllBooks() Dim FileName As String Dim OpenedBook As Workbook Dim IsBookOpen As Boolean ChDir (ThisWorkbook.Path) FileName = Dir("*.xls") Do While FileName <> "" IsBookOpen = False For Each OpenedBook In Workbooks If OpenedBook.Name = FileName Then IsBookOpen = True Exit For End If Next If IsBookOpen = False Then Workbooks.Open (FileName) End If FileName = Dir() Loop End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • ham_kamo
  • ベストアンサー率55% (659/1197)
回答No.4

こんにちは。前回回答したham_kamoです。 いろいろ試しているうちに他の方々が回答してくれましたが、一応私の回答は以下の通りです。 まず、 ChDir (ThisWorkbook.Path) FileName = Dir("*.xls") を FileName = Dir(ThisWorkbook.Path & "\*.xls") に変更し、さらに Workbooks.Open (FileName) の部分（前回エラーが出た場所です）を、 Workbooks.Open (ThisWorkbook.Path & "\" & FileName) に変更してみてください。

teru5000
質問者

お礼

有難うございます。 ham_kamoさんのやり方で、思う通りの動作が実現できました。 他のPCで試しても問題ありません。 いろいろな方に返答いただき有難うございます。 質問がうまく出来ていなかったため混乱させてしまったようで 申し訳ありませんでした！

その他の回答 (3)

  • tetra
  • ベストアンサー率33% (1/3)
回答No.3

'ChDir (ThisWorkbook.Path) をコメントにし、以下の一行を実行してください。 Application.DefaultFilePath = ThisWorkbook.Path

  • Yeti21
  • ベストアンサー率47% (396/830)
回答No.2

別のところでも書きましたが、UNC名や別ドライブに対するchdirは機能しません。 APIを使用して切り替える方法も有りますが、 単にファイルを開きたいだけならカレントディレクトリを移動する必要は無いと思います。 ChDir (ThisWorkbook.Path) FileName = Dir("*.xls") ↓ FileName = Dir(ThisWorkbook.Path & "\*.xls") で良いのではないでしょうか？

teru5000
質問者

補足

>FileName = Dir(ThisWorkbook.Path & "\*.xls") このやり方も試したのですがエラーが出てしまいます。 実行時エラー1004「ファイル名およびファイルの保存場所が正しいかどうか確認して下さい」というようなエラーです。 ドライブ名も指定せずにファイルをどんなドライブに移動しても対応できるようにしたいのですが…。

  • zap35
  • ベストアンサー率44% (1383/3079)
回答No.1

＞カレントフォルダをオプションで違うドライブに設定しているとうまく動作しないのですが このマクロはアクティブなブックの保存先ディレクトリにある全てのブックを開く仕様になっていると思います。ですから上記の意味がよく理解できません。 「\\AAAA\BB」とありますが、今の仕様をネットワークドライブのフォルダにあるエクセルファイルを開くように変えたいということでしょうか？　もしそうなら、 ChDir (ThisWorkbook.Path)はカレントディレクトリを変更する命令ですから、意味が分かれば簡単だと思います ChDir ("\\AAAA\BB") にすればリモートドライブを指定できます。またローカルディスクなら ChDir ("D:\AAAA\BB") のようにフルパスで指定すれば良いと思います。 質問の意味が正確に理解できていませんので、的はずれならご容赦ください。

teru5000
質問者

補足

>「\\AAAA\BB」とありますが、今の仕様をネットワークドライブのフォルダにあるエクセルファイルを開くように変えたいということでしょうか？　 ネットワークドライブ、ローカルディスク両方に対応したいということです。パスは特定でなく、マクロを実行するファイルを別のフォルダに移動したらその移動先のフォルダ内のファイルを開けるようにしたいということです。

  1. カテゴリ
  2. [技術者向] コンピューター
  3. OS（技術者向け）
  4. Windows系OS

関連するQ&A

  • フォルダ内の全てのファイル開く時間短縮の方法

    Excelのマクロを使ってフォルダ内の全てのファイルを開く以下のコードを利用しているのですが（教えてgoo！で教えて頂いたコードです）、ファイル数が１０個くらいあるため全部開くのに１分くらいかかってしまいます。 もっと時間を短縮することはできませんでしょうか？ Sub OpenAllBook() 　　Dim FileName As String 　　Dim OpenedBook As Workbook 　　Dim IsBookOpen As Boolean 　　ChDir ("フォルダ名") 　　FileName = Dir("*.xls") 　　Do While FileName <> "" 　　　If FileName <> ThisWorkbook.Name Then 　　　　IsBookOpen = False 　　　　For Each OpenedBook In Workbooks 　　　　　If OpenedBook.Name = FileName Then 　　　　　　IsBookOpen = True 　　　　　　Exit For 　　　　　End If 　　　　Next 　　　　If IsBookOpen = False Then 　　　　　Workbooks.Open (FileName) 　　　　End If 　　　End If 　　　FileName = Dir() 　　Loop End Sub

  • Excelのブック間の串刺し計算について

    Excelのブック間の串刺し計算について VBA超初心者です。同じフォルダ内にファイルがいくつかあり、同じ形式で、sheet1のB4のセルに計があったとして、それをブック間で串刺し集計したいのですが、うまくいきません。どこが悪いのかもわからず、困り果ててます。ご指導お願いします。 Sub BookShuukei() Dim FileName As String Dim Total As Integer Dim OpenedBook As Workbook Dim IsBookOpen As Boolean FileName = Dir("*.xls") Application.ScreenUpdating = False Do While FileName <> "" If FileName <> ThisWorkbook.Name Then IsBookOpen = False For Each OpenedBook In Workbooks If OpenedBook.Name = FileName Then IsBookOpen = True Exit For End If Next If IsBookOpen = False Then Workbooks.Open (FileName) End If Total = Total + Workbooks(FileName).Sheets(1).Range("B4").Value If IsBookOpen = False Then Workbooks(FileName).Close End If End If FileName = Dir() Loop Application.ScreenUpdating = True MsgBox (Total) End Sub

  • vba で全てのエクセルファイルを開く処理

    お世話になります。 下記のVBAソースで、特定のフォルダにあるエクセルを全て 開く処理をしているのですが、スマートに行えているか 疑問に思いました。 具体的には、「'''''''''時間がかかっている？？」箇所で 無駄なこと・時間がかかっていないか疑問です。 目的としては、「vba で全てのエクセルファイルを開く処理」ですので、 (1)皆さんがされている「vba で全てのエクセルファイルを開く処理」 (2)下記ソースの「'''''''''時間がかかっている？？」は時間がかかっていないか の、どちらかで、結構ですのでご返事頂ければ有り難いです。 宜しくお願いします。 ------------ソース----------------- ChDir (ThisWorkbook.Path & "\" & フォルダ) fileName = Dir("*.xls") Do While fileName <> "" If fileName <> ThisWorkbook.Name Then IsBookOpen = False '''''''''時間がかかっている？？ For Each OpenedBook In Workbooks If OpenedBook.Name = fileName Then IsBookOpen = True Exit For End If Next '''''''''時間がかかっている？？ If IsBookOpen = False Then Workbooks.Open (fileName) End If End If fileName = Dir() Loop

  • ファイル名が決まっていないファイルのデータを取り出しひとつのファイルにまとめる

    初めまして。 マクロ超初心者です。まだまだ勉強中でして自分で作るのは困難です。しかし、来月には必要なので…　よろしくお願いします! エクセル2000で以下のマクロを作成したいです。 １．フォルダ内のCSVファイルを開き、中のデータをひとつにまとめる。 （フォルダ名とファイル名、ファイル数はその時によって変わってきます。ファイル数はだいたい10個くらいです。ひとつのデータは20列50行くらいで列の項目を基準にまとめたいです。） ２．列を1列目に挿入し、2列目と3列目のデータを1列目に統合する。 ３．1列目のデータを使用し、重複を調べる。重複がある場合はどちらかひとつを削除する。（できれば4列目のデータを比較し数値が少ないほうを削除したいです。） ファイルを開くところまでは検索して探し当てたのですが、ファイル名が決まっていないことが難しく詰まってしまいます。 Sub OpenAllBooks() Dim filename As String Dim openedbook As Workbook Dim isbookopen As Boolean 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 If isbookopen = False Then Workbooks.Open (ThisWorkbook.Path & "\" & filename) End If filename = Dir() Loop End Sub 詳しい方よろしくお願いします！

  • ブックの集計方法について

    複数ファイルにある特定のシートのA列に記載がある時だけ、その行のA列からJ列までを、一つのファイルにコピーしたいと思っています。 ネットで調べてみたところ、エクセルで複数ファイルにある特定のシートの 特定した範囲を一つのファイルにコピーするマクロを探すことができました。 複数のシートから特定のシートのA列に文字がある場合は、J列までを一つのファイルの同じシートにコピーするようなことは出来ないでしょうか？ （例えば、各ブックA列に10行ずつ文字がある場合は、このようなとりまとめをできないかと考えています。） ブック１（シート名：Q2）⇒集計シートのA１：J１０ ブック２（シート名：Q2）⇒集計シートのA１１：J２０ ブック３（シート名：Q2）⇒集計シートのA２１：J３０ Sub ブック集合() Dim FileName As String Dim c As Integer Dim OpenedBook As Workbook Dim IsBookOpen As Boolean ChDir "c:/test" FileName = Dir("*.xls") Application.ScreenUpdating = False Application.DisplayAlerts = False c = 0 Do While FileName <> "" If FileName <> ThisWorkbook.Name Then IsBookOpen = False For Each OpenedBook In Workbooks If OpenedBook.Name = FileName Then IsBookOpen = True Exit For End If Next If IsBookOpen = False Then Workbooks.Open (FileName) End If Workbooks(FileName).Sheets("Q2").Range("A1:J500　").Copy _ ThisWorkbook.Sheets(3).Cells(c * 500 + 1, 1).PasteSpecial(xlPasteValues) c = c + 1 If IsBookOpen = False Then Workbooks(FileName).Close End If End If FileName = Dir() Loop Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub

  • ファイル名のわからない複数のファイルをひとつにまとめる

    エクセル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

  • あるフォルダ内のすべての.xlsファイルを開いて印刷

    お世話になります。 エクセルVBAの質問です。 あるフォルダを指定して、その中のファイルを順番に開いて印刷したいと思っていますが、どのように記述したらよいのでしょうか。 下記、いろいろなところから引っ張ってきたのをつないだコードです。 すみませんが、ご教授願います。 Dim ShellApp As Object Dim oFolder As Object Dim targetFolderName As String Dim Xlname As String, Dpath As String, Opn As Integer Dim Fnd As Boolean Set ShellApp = CreateObject("Shell.Application") Set oFolder = ShellApp.BrowseForFolder(0, "フォルダ選択", 1) If oFolder Is Nothing Then Exit Sub End If targetFolderName = oFolder.items.Item.Path Dpath = "targetFolderName" Xlname = Dir(Dpath & "*.xls") Do While Xlname <> "" Opn = 0 Do Fnd = False For Each file_name In Windows If file_name.Caption = Xlname Then Fnd = True Exit For End If Next If Not Fnd Then If Opn = 1 Then Exit Do Workbooks.Open Filename:=Dpath & Xlname Opn = 1 End If ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Loop Xlname = Dir() Loop

  • エクセルマクロ　フォルダ内のファイル検索で

    よろしくおねがいします。 下記で、どうも指定フォルダ内のファイル名を検索できていないようで 条件の"ないなら"に反応して中断するハズがファイルを開いてしまいます。 思ったのですが、bufの設定にファイル名は指定できないのでしょうか？ Sub Start8() Dim buf As String, IptA As String Const Path As String = "C:\001\" IptA = Workbooks("AAA.xls").Sheets("Sheet1").Cells(1, 1).Value buf = Dir(Path & "" & IptA & ".txt") If buf = "" Then Range("A2").Select ActiveCell.FormulaR1C1 = "" & IptA & "は見つかりません" Exit Sub Else Range("A2").Select ActiveCell.FormulaR1C1 = "" & IptFN & "が見つかりました" End If Workbooks.OpenText Filename:= _ "C:\001\" & IptA & ".txt" End Sub

  • マクロ　エクセル２００３

    いつも回答して頂き感謝しています。 原紙のブックを開き、別の名前を付けて保存するマクロを考えています。 原紙のブックを開くマクロはネットから探して、少し修正して出来あがったのですが、 この開いた原紙のブックに別の名前を付けて保存するマクロで困っています。 ただ単に名前を付けるだけだったら問題無いのですが、 その名前が既に保存されていないか確認した後、保存としたいのです。 ブックを開く記述を少し引用して出来ないかやってみたのですが、 Const Target2 As String = "C:\Users\Owner\Documents\" & NewFile で、定数式が必要です。と表示されエラーが発生してしまいます。 どのように変更したら上手くいくのでしょうか？宜しくお願い致します。 Sub Sample() Dim buf1 As String Dim buf2 As String Dim NewFile As String Dim ws1 As Worksheet Dim wb As Workbook Set ws1 = ThisWorkbook.Worksheets("作成") NewFile = "借入貸出" & ws1.Range("C4").Value & "." & ws1.Range("D4").Value Const Target1 As String = "C:\Users\Owner\Documents\借入貸出原紙.xlsx" Const Target2 As String = "C:\Users\Owner\Documents\" & NewFile　& ".xlsx" buf1 = Dir(Target1) If buf1 = "" Then MsgBox Target1 & vbCrLf & "は存在しません", vbExclamation Exit Sub End If For Each wb In Workbooks If wb.Name = buf1 Then Application.DisplayAlerts = False Workbooks("借入貸出原紙.xlsx").Close Application.DisplayAlerts = True End If Next wb Workbooks.Open Target1 buf2 = Dir(Target2) If buf2 = "" Then End If End Sub

  • VBAでフォルダにあるエクセルファイルを開く

    こんにちは　このコードがうまく動かないのですが、 どこがいけないのかわからなく助けてください。 なおフォルダの中には******データ.xlsと言うファイルがあり、アスタリスク部分は日付が不規則に変化して上書きされるのです。 このファイルを開くマクロを作りたいのですが。 うまく行きません。 よろしくおねがいします。 Sub excelopen() ' ' Dim エクセル As String 'エクセル = Dir(ActiveWorkbook.Path & "\*データ.XLS") If エクセル = "" Then Exit Sub エクセル = ActiveWorkbook.Path & "\" & エクセル Workbooks.Open Filename:=エクセル End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する