質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

87.80%

【VBA】ファイルの読み込み、ファイルの名前取得

解決済

回答 1

投稿

  • 評価
  • クリップ 1
  • VIEW 7,815

score 37

23歳OLです。プログラミング初心者です。

ご質問させていただきます。

▼やりたいこと
========================
・選択したファイルの中身を一行ずつ取り出し、
・選択したファイル名を一つずつシートに書き込んでくれる
ツール
========================

▼困っていること
========================
・選択したファイルの中身を一行ずつ取り出し、(ここで一回)
・選択したファイル名を一つずつシートに書き込んでくれる(ここでもう一回)

合計2回ファイル選択のウィンドウが開いてしまう。
→なんとか、一回の選択ウィンドウで選択したファイルの中身を取り出し、
ファイルの名前を取り出してシートに書き込んでほしい。
========================

▼現在書いているコード
========================

Sub ReadMultiFiles()
' [[ 変数定義 ]]
Dim varFileName As Variant
Dim VWorkSheet As Worksheet
Dim NewWorkSheet As Worksheet
Dim SheetName As String
Dim Filename As Variant
Dim c As Long
Dim a As Variant

Dim s1 As Worksheet
Dim s2 As Worksheet
Dim s3 As Worksheet
Dim s4 As Worksheet


Set s1 = Worksheets("全体RESULT")
Set s2 = Worksheets("部分RESULT")
Set s3 = Worksheets("データ")
Set s4 = Worksheets("chushutu")





' [[ ファイルパスからファイル名を取得 ]]
SheetName = "chushutu"
' [[ ファイル名で新しいシート作成 ]]
Set NewWorkSheet = CreateWorkSheet(SheetName)


' [[ 複数ファイルパス名を取得 ]]
varFileName = Application.GetOpenFilename(FileFilter:="(*.*),*.*", _
Title:="ファイルの選択", MultiSelect:=True)

' [[ ファイルパス取得できなかったら ]]
If IsArray(varFileName) = False Then
Exit Sub
End If

' [[ ファイルパス取得できたら ]]
c = 0
For Each Filename In varFileName

' [[ ファイルを開く ]]
Dim buf As String, n As Long
Open Filename For Input As #1
c = c + 1
Do Until EOF(1)
Line Input #1, buf

a = Split(buf, vbLf)
Cells(1, c).Resize(UBound(a), 1) = Application.Transpose(a)
Loop

' [[ ファイルを閉じる(保存無し) ]]
Close #1
Next Filename



s3.Select


'ファイル名取得()
Dim sPath As String, buf2 As String, cnt As Long
    With Application.FileDialog(msoFileDialogFolderPicker) ' ▲

If .Show <> True Then Exit Sub ' ▲
sPath = .SelectedItems(1) ' ▲
End With ' ▲

buf2 = Dir(sPath & "\*.*")
Do While buf2 <> ""
cnt = cnt + 1
Cells(cnt + 12, 2) = buf2
buf2 = Dir()
Loop

'抽出してきたものを、列にセットする

s4.Select
Columns("A").Copy

s4.Select

Columns("A").Copy


s4.Select
Columns("B").Copy

s5.Select

Columns("A").Copy


s4.Select
Columns("C").Copy

s6.Select

Columns("A").Copy






End Sub

' [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]
' [[ ]]
' [[ ワークシート名を指定したワークシートの作成 ]]
' [[ ]]
' [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]
Function CreateWorkSheet(WorkSheetName As String) As Worksheet

' 変数定義
Dim NewWorkSheet As Worksheet
Dim iCheckSameName As Integer

' ワークシートの作成
' ※一番最後に挿入
Set NewWorkSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))

' 同じ名前ワークシートが無いか確認
iCheckSameName = 0
For Each WS In Sheets
If WS.Name = WorkSheetName Then
MsgBox "ワークシート名:" + WorkSheetName + " この名前は既に使われています。"
iCheckSameName = 1
End If
Next

'同じ名前のワークシートがなければ
If iCheckSameName = 0 Then
NewWorkSheet.Name = WorkSheetName
Set CreateWorkSheet = NewWorkSheet
End If

End Function
================================================

つたない説明で申し訳ございませんが、ご教示よろしくお願いします。


  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 1

checkベストアンサー

+2

最初に開いたウィンドウで選択したファイルであれば、
' [[ ファイルパス取得できたら ]] 
c = 0 
For Each Filename In varFileName 
の時点でvarFileNameという配列に入っているはずなので、
For Each Filename In varFileName 
Filenameという変数にファイル名がフルパスで入っているのでなんやかんや
Next Filename 
という流れでいけるのではないかと思います。
Filenameにはファイルのフルパスが入っているので、フォルダ名を除いたファイル名を取得するために一手間必要ですが。
とりあえずヒントだけです(考えて書かないと覚えられませんし)。


※追記
とりあえずヒントだけと思ったんですが、時間があったので例を。
'ファイル名取得() 
Dim sPath As String, buf2 As String, cnt As Long 
    With Application.FileDialog(msoFileDialogFolderPicker) ' ▲ 
 
If .Show <> True Then Exit Sub ' ▲ 
sPath = .SelectedItems(1) ' ▲ 
End With ' ▲ 
 
buf2 = Dir(sPath & "\*.*") 
Do While buf2 <> "" 
cnt = cnt + 1 
Cells(cnt + 12, 2) = buf2 
buf2 = Dir() 
Loop 

cnt = 0
For Each Filename In varFileName
Cells(cnt + 12, 2) = Mid(Filename, InStrRev(Filename, "\") + 1)
cnt = cnt + 1
Next Filename
こんな感じでしょうか。

Cells(cnt + 12, 2) = Mid(Filename, InStrRev(Filename, "\") + 1)
この行がシートのオブジェクトを指定していないのが気になりますが。。。

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2015/03/05 11:45

    横からスミマセン。
    プログラミング以前の知識ですので、そこから勉強した方が結果的に近道ですよ。
    「パスとは」で検索してみましょう。

    それと老婆心ながら23歳OLという情報は要らないかと思います。レベルを伝えたいのなら「初心者です」の方がすっきりすると思います。

    頑張ってください

    キャンセル

  • 2015/03/05 12:54

    Guuさんのアドバイス通り「パスとは」で検索したりすれば分かると思いますが、一応回答しておきます。
    「\」はファイルパスの区切り文字です。
    Cドライブの「フォルダ1」というフォルダの中の「フォルダ2」というフォルダの中に「てすと.csv」というファイルがあるとすると、ファイルのパスは「C:\フォルダ1\フォルダ2\てすと.csv」となります。
    > InStrRev(Filename, "\")
    は、ファイルのパスの最後の区切り文字の位置を探しているので、+1した位置から切り出すとパスから保存フォルダを除いたファイル名だけが切り出されます。

    デスクトップにフォルダを作ってその中にファイルを作って、エクスプローラ(フォルダの中身一覧画面)で開いてアドレスバーのクリックしてみるとパスにどういう文字列が入るのか分かると思います。

    おそらくFilename変数の中身の確認は行っていないのだと思いますが、変数の値を確認する手段を調べておくと良いと思います。

    それと、Guuさんの言うとおり23歳OLという情報は不要かと思います。
    23歳OLでも57歳窓際族でも同じように教えますので笑

    キャンセル

  • 2015/03/06 09:43

    ご教授ありがとうございます。

    >ファイルのパスの最後の区切り文字の位置を探しているので、+1した位置から切り出すとパスから保存フォルダを除いたファイル名だけが切り出されます。

    なるほど!そういう意味だったのですね!ありがとうございます(*^。^*)

    >23歳OLでも57歳窓際族でも同じように教えますので笑
    本当ですか~?笑 今度試しに書いちゃいますよ!(^^)!

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 87.80%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る