• ベストアンサー

ブックに可変のファイル名テキストファイルからデータを取り込みたい

こんにちは 昨日質問させていただいた、コードを修正して 開かれるファイル名が可変である場合にも対応させたいのですが、"*"をもちいてみてもうまく行きません。 どの様に指定するのかご存知の方教えてください。 "\Fuji.txt"これを\****.txt \*.txtとやってみましたがダメでした。 なお、041221_fuji.txtのように日付を6桁と"_"を入れてfujiとしたく、日付の6桁の数字のみ変えたいのです。 それを下記のコードに盛り込みたいのですが、何が足りないのかうまく行きません。 宜しくお願いします。 Sub ReadTxt() Dim myTxtFile As String Dim myBuf As String, wkdt() As String Dim i As Integer, j As Integer Application.ScreenUpdating = False myTxtFile = ActiveWorkbook.Path & "\Fuji.txt" Worksheets("郵便番号").Activate Open myTxtFile For Input As #1 Do Until EOF(1) Line Input #1, myBuf wkdt = Split(myBuf, vbTab) 'データをセルに展開する i = i + 1 For j = 0 To UBound(wkdt) Cells(i, j + 1) = wkdt(j) Next j Loop Close #1 End Sub

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

  • ベストアンサー
  • ki-aaa
  • ベストアンサー率49% (105/213)
回答No.3

Dirを使ったら如何でしょう。 >myTxtFile = ActiveWorkbook.Path & "\Fuji.txt" これを myTxtFile = Dir(ActiveWorkbook.Path & "\*Fuji.txt") if myTxtFile = "" then exit sub myTxtFile = ActiveWorkbook.Path & "\" & myTxtFile

shinarin
質問者

お礼

早速のアドバイス有難うございます。 思い通りに動きました。 このコードを使わせてもらいます。

その他の回答 (2)

  • WWolf
  • ベストアンサー率26% (51/192)
回答No.2

方法としてソースをそのまま使い修正追加するなら。 Sub ReadTxt() Dim myTxtFile, Fn As String Dim myBuf As String, wkdt() As String Dim i As Integer, j As Integer Application.ScreenUpdating = False Fn=inputbox("ファイル名は?") myTxtFile = ActiveWorkbook.Path & "\" & Fn & ".txt" Worksheets("郵便番号").Activate Open myTxtFile For Input As #1 Do Until EOF(1) Line Input #1, myBuf wkdt = Split(myBuf, vbTab) 'データをセルに展開する i = i + 1 For j = 0 To UBound(wkdt) Cells(i, j + 1) = wkdt(j) Next j Loop Close #1 End Sub

shinarin
質問者

お礼

アドバイス有難うございます。 ボックスが出てきてファイル名を入れないと動かないので、完全オートと行かないのが残念です。 でもこんなやり方もあるんですね。 参考になりました。 有難うございました。

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.1

下記を参考に。 Sub etst01() d = Date s = Format(d, "yymmdd") fn = s & "fuji.txt" MsgBox fn End Sub

shinarin
質問者

お礼

アドバイスありがとうございます。 惜しいのですが、日付が今日とは限らない所が 苦しいところなんです。 色々このアイデアを引用してIf文にしてみたりしましたが、難しく日付を取るのはギブアップしました。 ありがとうございます。

関連するQ&A

  • ブックをひらかずにテキストファイルを取り込む

    エクセルのブックを開かずにテキストファイルを取り込みたいのですが、対象のテキストファイルは タブで分かれています。 本を見て 下記のプロシージャを使用したいのですが、 テキストが取り込まれるブックに郵便番号と言うシートを作成してもうまく取り込めません。 テキストはタブで区切られたテキストで 7列のデータです。 下記のものを開こうとすると、7列でデータが入るのですが、タブでデータが区切られてこないのです。 データが続いて一つのセルに入ってしまい、 うまく設定できません。 何がいけないのでしょうか? 宜しくお願いします。 Sub ReadTxt() Dim myTxtFile As String Dim myBuf(7) As String Dim i As Integer, j As Integer Application.ScreenUpdating = False myTxtFile = ActiveWorkbook.Path & "\Fuji.txt" Worksheets("郵便番号").Activate Open myTxtFile For Input As #1 Do Until EOF(1) Input #1, myBuf(1), myBuf(2), myBuf(3), myBuf(4), _ myBuf(5), myBuf(6), myBuf(7) 'データをセルに展開する i = i + 1 For j = 1 To 7 Cells(i, j) = myBuf(j) Next j Loop Close #1 End Sub

  • エクセルのデータを大量のテキストファイルに書き込みたい。

    エクセルの縦のセルのデータ(下のCells( 4 * j + i, 4))を繰り返しで、400個のテキストファイルに書き込みたいのですが、 下の""内のjは繰り返しせずに、j.txtとなって入力されてしまいます。なにかいい方法がありませんでしょうか。 ご協力お願いします。(ちなみにvbaは初心者です。) Private Sub CommandButton2_Click() Dim n As Long n = FreeFile Dim j As Integer For j = 0 To 399 For i = 1 To 4 a = Cells( 4 * j + i, 4) f2 = ActiveWorkbook.Path & "\j.txt" Open f2 For Append As #n Print #n, a Close #n Next i Next j End Sub 例. 1 2 3 4 5 6 7 8 9 10 12 13 1,2,3,4→1.txt 5,6,7,8→2.txt 9,10,11,12→3.txt

  • エクセルVBA:テキストデータ(txt)の読込(改行が変なところでされる)

    勉強しながら、エクセルVBAを組んでみたのですが うまくいきません。 テキストデータを以下のようなプログラムで読んだのですが (100行のデータを縦に並ぶように100個のセルの書き出す) 読み込みデータに「↓」で改行されているところでは 「↓」の間は同一行と見なされてしまうのですが どのようにしたら一行で一つのデータと見てくれるのでしょうか? 分かる方がいましたら教えて下さい。 よろしくお願いします。 Sub pon() '*** 変数の宣言 *** Dim filenum As String Dim i As Integer Dim num As Integer, ms As String, cnt As Integer Dim BookName As String, PathName As String Dim ca As String cnt = 1 i = 1 ca = Cells(1, 56) PathName = "C:\" textpath = Dir(PathName & "pon" & ca & ".txt") BookName = Dir(PathName & "pon" & ca & ".txt") Open PathName & BookName For Input As #1 'ファイルを開きます Do While Not EOF(1) Line Input #1, ms cnt = cnt + 1 Cells(1, 57) = BookName 'データの書き出し Cells(cnt, 56) = ms 'データの書き出し Loop Close #1 End Sub

  • ラベルに全てのテキストデータを読み込みたい

    メモ帳(.txt)に AAAA BBBB CCCC と書いて、これら3行をラベルに表示させたいのです。 Private Sub Form_Load()  Dim myText As String  Open "C:\myFile.txt" For Input As #1 Do While Not EOF(1) Input #1, myText Loop   Close #1  Label1.Caption = myText End Sub 上記のコードだと1行目のAAAAしか表示されません(泣) どなたかご指導宜しくお願いします。

  • 新規テキストファイルを作成して日付名で保存したい。

    すみません誰か、教えて下さい。 新規でテキストファイルを作成して、日付名で保存を しようとしたのですが、ファイル名が不正とのエラーが出ます。 どうすればいいか、教えて頂けませんでしょうか。 また、保存先の指定方法も分かりません。保存先の指定方法も あわせて教えて頂けませんでしょうか。 宜しくお願いします。 Sub 保存() Dim myFileNo As Integer Dim i As Long Dim myLastRow As Long Dim IMA As String IMA = Now & ".txt" Worksheets("内容").Activate myLastRow = Range("A1").CurrentRegion.Rows.Count myFileNo = FreeFile Open IMA For Output As myFileNo For i = 1 To myLastRow Write #myFileNo, Cells(i, 3) Next i Close #myFileNo End Sub

  • リストボックスの内容を テキストファイルに出力

    エクセル vba初心者です。 (1)ini fileからデータを取得 (2)その内容のリストボックスに表示 (3)リストボックス内容をテキストボックスに出力 (2)、(3)がわかりません。 なんとなくやってたら余計にわからなくなりました。助けてください。 Private Sub CommandButton1_Click() '読込み(1)を押した時の処理 Dim listbox As String Dim strL_Data As String '取得した値 Dim n As Integer n = FreeFile    ListBox1.Clear   Open "C:\filepath.ini" For Input As #n Do While Not EOF(n) Line Input #n, listbox ListBox1.AddItem listbox Loop Close #n End Sub Private Sub CommandButton2_Click() '書込み(1)を押した時の処理  Dim listbox As String Dim strL_Data As String '取得した値 Dim n As Integer n = FreeFile    Open "c:\example.txt" For Output As #n Print #n, strL_Data Close #n End Sub よろしくお願いいたします。

  • ExcelVBAを使ってテキストファイルを取り込む際に条件を与える方法

    こんばんわ。 今、テキストファイルをExcelの特定シートに開くVBAを組もうとしています。 ある書籍のソースをそのまま流用すると、 一部分は満たされるのですが、他方が実現されず、困っております。 やろうとしていること: 新規ブックを開かずに、テキストファイル(CSV形式)の各列の形式(文字列or数値)を指定しながら、特定シートにデータを展開する。 Book名「ABC.xls」 その中のシート名「展開」 テキストファイル名「data.txt」:11列のデータがカンマ区切りで入っています data.txt、ABC.xls共に同じフォルダ内に保存してあります。 やってみたこと: *********************************************** Sub ReadTxt() Dim myTxtFile As String Dim myBuf(11) As String Dim i As Integer, j As Integer Application.ScreenUpdating = False myTxtFile = ActiveWorkbook.Path & "\data.txt" Worksheets("展開").Activate Open myTxtFile For Input As #1 Do Until EOF(1) Input #1, myBuf(1), myBuf(2), myBuf(3), myBuf(4), myBuf(5), myBuf(6), _ myBuf(7), myBuf(8), myBuf(9), myBuf(10), myBuf(11) i = i + 1 For j = 1 To 11 Cells(i, j) = myBuf(j) Next j Loop Close #1 End Sub *********************************************** というソースで特定シートに取り込めたのですが、 各列の取り込み形式(文字列、数値)を指定する方法がわかりません。 OpenTextメソッドでFieldInfoに配列を記述し取り込み形式を指定する方法は見つけたのですが、こちらは、新規ブックが開いてしまい・・・ どなたか方法をご存知の方、回答を頂けたら幸いです。 お願いします。

  • エクセルに二つのテキストファイルをインポートしたい

    エクセルのsheet1の1行目にタイトルがあります。 ボタンのクリックイベントで、テキストファイル2つをインポートしたいのですが。 ・テキストファイルの名前は、固定ではありません ・テキストファイルの保存先は、デスクトップで、ファイルの選択は自分でしたい ・テキストファイルの一行目は、タイトル行なので、二行目以降をインポートしたい 行数は固定ではありません ・タブ区切りです 複数選択はできなく、1ファイルでタイトル行も含めるのであれば下記コードできたのですが。 どなたか、ご教示いただけますでしょうか・・・・ よろしくお願いいたします。 ----------------------------------------------------- Sub ReadTextFile() 'タブ区切りファイルを全て文字列として読み込む Dim FileName As String Dim i As Long Dim Cnt As Long Dim Buf As Variant Dim FileNo As Integer Dim SplitString As Variant 'ファイルダイアログを表示 FileName = Application.GetOpenFilename("テキストファイル,*.txt") If FileName <> "False" Then '全セル選択して書式を文字列にセットする Cells.Select Selection.NumberFormatLocal = "@" Cells(1, 6).Select '空いているファイル番号を取得 FileNo = FreeFile() Buf = Space(FileLen(FileName)) 'ファイルを開いてbufに1行読み込み ' → タブで配列に分割 ' → セルに書き出し Open FileName For Input As #FileNo Do Until EOF(FileNo) Line Input #FileNo, Buf Cnt = Cnt + 1 SplitString = Split(Buf, vbTab) For i = 0 To UBound(SplitString) Cells(Cnt, i + 1) = SplitString(i) Next i Loop Close #FileNo Else End If End Sub -----------------------------------------------------

  • エクセルからテキストファイルはきだし

    エクセルのひとつのシートの内容をテキスト形式で吐き出すマクロを教えてください。 エクセルでHTMLメルマガの商品名や金額を編集できるようにしたいのですが、その編集後のファイルをテキストで出すマクロのVBAの書き方を教えてください。 現在、以下で書いておりますがエクセルの中にある「$」が消えてしまいます。$が消えないような書き方を教えてください。また、""が余分についてしまう書き方は避けたいです。よろしくお願い致します。 Sub test() Dim StrFN As String StrFN = ActiveWorkbook.Path & "\data.txt" Dim i As Long, LngLoop As Long Dim IntFlNo As Integer Worksheets("HTML").Activate LngLoop = Range("a65536").End(xlUp).Row IntFlNo = FreeFile Open StrFN For Output As #IntFlNo For i = 1 To LngLoop Print #IntFlNo, Cells(i, 1) Next i Close #IntFlNo End Sub

  • EXCEL2007のVBAを使って、テキストファイルを読み込んで別のテ

    EXCEL2007のVBAを使って、テキストファイルを読み込んで別のテキストファイルを作って書き込むというコードを書きましたが、新しく出来たテキストファイルの末尾に、もともとのファイルには無かったスペースが追加されてしまいます。 原因と対策を教えて頂きたいです。 ------------------------------------------------------- Dim FileName1 As String Dim FileName2 As String Dim FileNumber1 As Integer Dim FileNumber2 As Integer Dim Data As String FileName1 = Application.GetOpenFilename("Text Files (*.txt), *.txt") FileName2 = Application.GetSaveAsFilename(, "Text Files (*.txt), *.txt") Data = Space(FileLen(FileName1)) FileNumber1 = FreeFile Open FileName1 For Binary As #FileNumber1 Get #FileNumber1, , Data Close #FileNumber1 'この間に"Data"内容を処理するコードを入れる予定 FileNumber2 = FreeFile Open FileName2 For Binary As #FileNumber2 Put #FileNumber2, , Data Close #FileNumber2 ------------------------------------------------------- このコードで1284バイトのテキストを読み込ませると末尾にスペースが追加されて1918バイトになってしまいました。 "Data"の内容を表示させてもスペースはなく、Len関数で大きさを調べても1284バイトです。

専門家に質問してみよう