• 締切済み

特定ファイルだけの取り込み許可

現在以下の方法でエクセルにCSVの取り込みを行っています。 =============================================================== Dim FileNames As Variant Dim fn As Variant FileNames = Application.GetOpenFilename("20080604,*.csv", MultiSelect:=True) If VarType(FileNames) = vbBoolean Then Exit Sub For Each fn In FileNames With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fn, Destination:=Worksheets("集計").Range("A1")) ~ ============================================================== 「20080604.csv」以外のファイルは取り込ませたくありません。 良い方法はありませんか? ファイルのディレクトリは不特定です。 よろしくお願いいたします。

みんなの回答

回答No.2

ワイルドカードを使わなきゃいいだけじゃ? *.csv → 20080604.csv

全文を見る
すると、全ての回答が全文表示されます。
  • marbin
  • ベストアンサー率27% (636/2290)
回答No.1

ループしないで直接 fn に指定のファイルのパスを代入してはいかがでしょう? 変数を使う必要もないような気がします。

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • VBA 外部テキスト読込 先頭の「0」の存在

    こんばんは。 エクセル2003 VBAについて質問いたします。 エクセルのシートにタブ切りテキストを読み込みしたいと思います。 ただ読み込みする訳ではなく、データには先頭に数字の「0」から始まる数字もあり、普通に読み込めばその先頭の数字が消えてしまい その「0」も表示したまま読み込みたく思います。 参考にしたソースは(下記 Sub TestMacro1() Dim Fname As Variant On Error Resume Next ActiveSheet.QueryTables(1).Delete 'QueryTableがあったら削除 On Error GoTo 0 Fname = Application.GetOpenFilename( _ "テキストファイル (*.txt; *.csv),*.txt;*.csv", 1, "OpenTextFile") If VarType(Fname) = vbBoolean Then Exit Sub '-------------------細かいオプションは、記録マクロから取り出してください。--- With ActiveSheet.QueryTables.Add( _ Connection:="TEXT;" & Fname, _ Destination:=Cells(1, 1)) .AdjustColumnWidth = False '列幅の自動調整 .TextFileCommaDelimiter = True 'カンマ切り .Refresh BackgroundQuery:=False 'バックグラウンドの再入力(一回きり) .TextFileTabDelimiter = True 'タブデリミタあり End With '------------------- ActiveSheet.QueryTables(1).Delete End Sub なのですが、二行目の部分しか型を指定してなく、Stringにもしてみましたが先頭に付く数字の「0」が消えてしまいます。 他に変更する場所がありますでしょうか? ご教授いただければ幸いです。 何卒、よろしくお願いいたします。

  • 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

  • CSVが文字コードUTF-8かどうかの判定

    かなりデータ量が多い(10万レコード超)CSVファイルが、100件近くあります。これをエクセルに取り込んで順次同じような作業をしようと思っています。とりあえずCSVを以下のコードで開いています。 Sub CSV入力4() 'クエリーテーブルを使ったCSV読み込みVBAコード Dim myFile As Variant myFile = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", Title:="CSVファイルの選択") If myFile = False Then Exit Sub End If ActiveSheet.Cells.Clear With ActiveSheet.QueryTables.Add(Connection:="text;" & myFile, Destination:=Range("A1")) ' .TextFilePlatform = 932 'Shift_Jis .TextFilePlatform = 65001 'UTF8 .TextFileCommaDelimiter = True .Refresh BackgroundQuery:=False .Delete End With MsgBox "読込完了" End Sub 問題は、CSVに拡張子で区別できないUTF-8のCSVファイルがあることです。事前にわかっていれば .TextFilePlatform = 932 'Shift_Jis .TextFilePlatform = 65001 'UTF8 の使い分けで対応できるのですが、開いてみて文字化けがあるかどうか調べないとわかりません。自動的に判定する方法はないでしょうか?

  • ExcelVBAを使用したCSVファイルのデータの取込みについて

    いろんなサイトの情報を見ながら作っていたのですがどうもうまくいかないのでアドバイスなど頂きたいです。 書き方もおかしいと思うのでこう記述するべきとかあったら教えてほしいです。 <やりたいこと> ダイアログボックスより取り込みたいcsvを選択 選択したファイルのパスを一度テキストボックスに書きだす。 新規シートを作成してシート名を変更して 先ほどテキストボックスに書きだした情報を元に CSVファイルのデータを新規作成したシートにコピーを張り付ける 呼び出したCSVファイルを閉じる といったようにしたいのです。 できたら欲しい情報の入った列だけとりだしたかったのですが・・・。 現状記述してあるのは下記になります。 これだととりあえずコピーできてるみたいですが、呼び出したCSVファイルが閉じないのです。 Private Sub CommandButton1_Click() Dim OpenFileName As Variant OpenFileName = Application.GetOpenFilename("CSVファイル(*.csv),*.csv") TextBox1.Value = OpenFileName End Sub Private Sub CommandButton2_Click() Worksheets.Add After:=Worksheets("Sheet1"), Count:=1 ActiveSheet.Name = "テスト" Workbooks.Open Filename:=TextBox1 ActiveSheet.Cells.Copy Destination:=ThisWorkbook.Sheets("テスト").Range("A1") Workbooks(TextBox1).Close End Sub

  • VBAでファイルOPEN ダイアログを使用したいです

    現在、指定したファイルを開くVBAを書いているのですが、 ↓こんなの ----------------------------------------------------------- Dim vntFileName As Variant 'ファイルを開くダイアログを開きます vntFileName = _ Application.GetOpenFilename( _ FileFilter:="エクセルファイル(*.xls),*.xls" & _ ",CSVファイル(*.csv),*.csv" _ , FilterIndex:=1 _ , Title:="開けゴマ" _ , MultiSelect:=False _ ) 'ファイルが選択されているときは '選択したファイルをWorkbooks.Openメソッドで開きます If vntFileName <> False Then Workbooks.Open Filename:=vntFileName End If ---------------------------------------------------------------- あらかじめ開くディレクトリを、ネットワーク上のフォルダに指定したいのですが、どこにパスを書いたらいいのか、わかりません。 教えていただけますでしょうか。

  • Excel VBA:ダイアログを使ってファイル名を取得したい

    ファイルを開く際に、GetOpenFilenameを使用し、以下のように記述しています。 Dim sFName As String Dim sPath As String sPath = ThisWorkbook.Path & "\データフォルダ" ChDir sPath sFName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", MultiSelect:=False) このとき、win98ですと、指定したフォルダが表示されますが、 win2000やXPですと、Excelのカレントフォルダが表示されます。 ダイアログ表示したときに、任意のフォルダを表示させるには、どのようにしたらよいですか? ご回答よろしくお願いします。

  • ホームページ上の複数のCSVファイルを、エクセルに自動取り込みする方法

    ホームページ上のCSVファイルをダウンロードし、そのデータをエクセルに貼り付けるマクロで、1回のマクロ起動で、複数のダウンロードファイルを同ブック内で別々のシートに貼り付けていくにはどのようにすればよいのでしょうか? 以下のマクロを教えて頂き、個々のデータを取る事は分かったのですが、新たに、複数の銘柄を一回のマクロで処理する方法を考えております。 以下のマクロであれば、IBMの株価をダウンロードして終了となるところを、DELLの株価、AAPLの株価と一回のマクロで同ブック内で別のシートにデータを貼り付けをしていきたいと思っています。 Sub sample1() Dim url As String Dim sDate As String Dim eDate As String Dim Symbol As String Dim i As Integer sDate = "1000/1/1" '開始日 eDate = "2010/12/31" '終了日 Symbol = "IBM" '銘柄 url = "​http://ichart.finance.yahoo.com/table.csv?g=d&ignore=.csv"​ url = url & "&s=" & Symbol url = url & "&a=" & Month(sDate) - 1 & "&b=" & Day(sDate) & "&c=" & Year(sDate) url = url & "&d=" & Month(eDate) - 1 & "&e=" & Day(eDate) & "&f=" & Year(eDate) 'データ読み込み With ActiveSheet .Cells.Delete For i = 1 To .QueryTables.Count .QueryTables(1).Delete Next With .QueryTables.Add(Connection:="TEXT;" & url, Destination:=.Range("A1")) .TextFileCommaDelimiter = True .Refresh End With End With End Sub

  • ファイルを開いた時、CSVデータを自動で取得したい

    毎日送られてくるCSVファイルがあります。 今まで手作業で「更新ファイル.exl」を作成していたのですが、開いた時に 自動更新したいと思い、あちらこちらのサンプルから引用したコードを試みましたが、途中で行き詰ってしまいました。  お力をお借りできれば、幸いです。 やりたことは、(1)「更新ファイル」A列に計算式を入れたい        (2)CSVファイルのA,B列は除き、C列以降を           「更新ファイル」のB列から貼り付けたい 現状では、CSVファイル、更新ファイル共にタイトル行がない状態です。 (タイトル行が必要なら、付け加えてもいいのですが、複数のファイルが この「更新ファイル」から引っ張ったデータを計算式で入れているため、 できるならば現状のままで作りたいのです) CSVファイル  A:年 B:月 C:商品コード1 D:商品コード2 E:支払いコード F:個数 G:金額 2007 5 1004 20 1 10 5000 現状:CSVデータそのままの形式で、「更新ファイル.exl」に出力されてしまうので、下記のように出力したいのです。 更新ファイル A:B&C&D B:商品コード1 C:商品コード2 D:支払いコード E:個数 F:金額 1004201   1004 20 1 10 5000 Private Sub Workbook_Open() Dim Workbooks As Variant Dim Sheets As Variant Dim Filename As Variant ThisWorkbook.Sheets("Sheet1").Activate Cells.Select Selection.ClearContents Filename = Application.GetOpenFilename("CSV ファイル(*.csv),*.csv") With ActiveSheet.QueryTables.Add _ (Connection:="TEXT;" & Filename, Destination:=Range("A1")) .TextFileCommaDelimiter = True .Refresh BackgroundQuery:=False End With End Sub  どこに、どんなコードを入れれば解決できるのか、教えて頂けたら、 うれしく思います。よろしくお願いします。

  • excelファイルを検索してセル内容を転記する方法

    VBA初心者です。 Aというディレクトリがあり、その中に1,2,3,4というフォルダがあります。 1には「apple1.csv」、「orange1.csv」、「banana1.csv」 2には「apple2.csv」、「orange2.csv」、「banana1.csv」 ・・・ 4には「apple4.csv」、「orange4.csv」、「banana4.csv」 が入っています。 この1から4のフォルダのapple1,apple2,apple3,apple4のファイルをとりだし、それぞれのA1~A10セルを新たなファイルに自動転記する(apple1はA1~A10,apple2はB10~B10・・・)といった具合のマクロを組みたいと思っています。 あるフォルダの中のexcelファイルであれば、以下のソースコードを用いてコピーしたいファイルを選択してセルを転記しているのですが、今回のように、ディレクトリがいくつもあり、その各ディレクトリ中のファイル名の共通項を検索してそのセルを転記する方法が全く分かりません。 どなたかわかる方アドバイスをお願いします。 Sub ブック保存() Dim j As Integer Dim ファイル一覧 As Variant ファイル名一覧 = Application.GetOpenFilename("apple,*.xlsm", MultiSelect:=True) If VarType(ファイル名一覧) = vbBoolean Then Exit Sub Application.EnableEvents = False For i = 1 To UBound(ファイル名一覧) Set ブック = Workbooks.Open(ファイル名一覧(i)) With ThisWorkbook.Worksheets(1) For j = 1 To 10 .Cells(j, i) = ブック.Worksheets(1).Cells(j, 1).Value Next End With ブック.Close Next Application.EnableEvents = True End Sub

  • Excelのマクロでファイルを開くのダイアログをキャンセルしたときの挙

    Excelのマクロでファイルを開くのダイアログをキャンセルしたときの挙動についてです。 マクロで次のような記述をしています。 Sub tekitou() Dim vntFileName As Variant vntFileName = _ Application.GetOpenFilename( _ FileFilter:="エクセルファイル(*.xls),*.xls" & _ ",CSVファイル(*.csv),*.csv" _ , FilterIndex:=1 _ , Title:="ファイルを開く" _ , MultiSelect:=False _ ) If vntFileName <> "False" Then Workbooks.Open Filename:=vntFileName End If うんたらかんたら End Sub このとき、ファイルを開くのダイアログをキャンセルしたときでも「うんたらかんたら」の部分が実行されてしまいます。 キャンセルを押したときにそこでそれ以降をスキップして何もなかったかのような挙動をさせるためにはどのような記述をすればいいのでしょうか?

このQ&Aのポイント
  • 2階建ての一軒家でWIFIの電波が届かない問題について、知恵を教えてください。
  • 質問者は仕事を2階で行うことになり、現在のルーターの電波が届かないため、古いルーターを活用したいと考えています。
  • 具体的には、知人のルーターをAPモードにする、自分のルーターと知人のルーターをLANケーブルで繋ぐ、などの方法を試しています。他にも良い方法があれば教えてほしいとのことです。
回答を見る

専門家に質問してみよう