Q&A
お返事ありがとうございます。
これで試してみたのですが、やはりファイルの名前を取得することができません。
23歳ＯＬです。
会社でマクロを組むことになりましたが、
初心者過ぎて全然よくわかりません。
お忙しいところ大変恐縮ですが、教えていただけないでしょうか。
※やりたいことがわかりづらいと思うのでもう少し詳しく書きます。
▼作っているもの
・複数のデータを読み込み
・その中身を一枚のシートにまとめ
・さらに読み込んだファイルの名前をシートに書き出してくれるツール
▼困っている内容
・複数のファイルは読み込むことができた。
しかし、ファイルの名前をシートに書き出してくる時点で、
ファイルの「名前」をシートに書き出すことができず、
代わりにファイルの「中身」を書き出してしまう。
→ファイルの名前をきちんととってこれるようにしたい。
======================================
▼現在書いているコード
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 dates As Worksheet
Set dates = Worksheets("データ")
' [[ ファイルパスからファイル名を取得 ]]
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
' [[ CSVファイルを開く ]] Dim buf As String, n As Long Open Filename For Input As #1 c = c + 1 Do Until EOF(1) Line Input #1, buf n = n + 1
a = Split(buf, vbLf)
Cells(n, c).Resize(UBound(a), 1) = Application.Transpose(a)
Loop
' [[ CSVファイルを閉じる(保存無し) ]] Close #1
Next Filename
dates.Activate
'ファイル名取得()
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) = buf buf2 = Dir() Loop
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
============================================================================
'ファイル名取得()
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) = buf buf2 = Dir() Loop
この部分単品で動かしたときは、きちんとファイルの名前をとってくることができ、ファイルの中身を吐き出したりはしない。
以上です。
お力を貸していただきたいです。
回答2件
0
ベストアンサー
buf2 = Dir(sPath & "\*.*")Do While buf2 <> ""
cnt = cnt + 1
Cells(cnt + 12, 2) = buf
buf2 = Dir()
Loop
この辺の
Cells(cnt + 12, 2) = buf
この行なんですが。
式の右側は「buf」ではなくて「buf2」ではないでしょうか？
bufだとその上のループで最後に読み込んだファイルの最後の行が出力されるような気がします。
投稿2015/02/26 13:03
総合スコア85
0
何がしたいのかわからなかったので、とりあえずこんな風にしてみました。
気になるところは色々ありますが、極力変更しない形でそれっぽくしてみました。
lang
1Sub ReadMultiFiles() 2 ' [[ 変数定義 ]] 3 Dim varFileName As Variant 4 Dim VWorkSheet As Worksheet 5 Dim NewWorkSheet As Worksheet 6 Dim SheetName As String 7 Dim Filename As Variant 8 Dim c As Long 9 Dim a As Variant 10 Dim dates As Worksheet 11 12 Set dates = Worksheets("データ") 13 14 ' [[ ファイルパスからファイル名を取得 ]] 15 SheetName = "chushutu" 16 ' [[ ファイル名で新しいシート作成 ]] 17 Set NewWorkSheet = CreateWorkSheet(SheetName) 18 19 ' [[ 複数ファイルパス名を取得 ]] 20 varFileName = Application.GetOpenFilename(FileFilter:="(*.*),*.*", _ 21 Title:="ファイルの選択", MultiSelect:=True) 22 23 ' [[ ファイルパス取得できなかったら ]] 24 If IsArray(varFileName) = False Then 25 Exit Sub 26 End If 27 28 ' [[ ファイルパス取得できたら ]] 29 c = 0 30 Dim i As Long 31 i = 1 32 For Each Filename In varFileName 33 34 ' [[ CSVファイルを開く ]] 35 Dim buf As String, n As Long 36 Open Filename For Input As #1 37 c = c + 1 38 n = 0 39 Do Until EOF(1) 40 Line Input #1, buf 41 n = n + 1 ' こうかな？ 42 'a = Split(buf, vbLf) ' line feedが区切り文字のCSVデータ？？？ 43 a = Split(buf, ",") ' よくわかんなかったので、とりあえずカンマで区切ってみた。 44 Cells(n, c).Resize(UBound(a) + 1, 1) = Application.Transpose(a) ' こうかな？ 45 n = n + UBound(a) ' こうかな？ 46 Loop 47 48 ' [[ CSVファイルを閉じる(保存無し) ]] 49 Close #1 50 51 ' こうかな？ 52 dates.Cells(i, 1).Value = Dir(Filename) 53 i = i + 1 54 Next Filename 55 56 ' これいらないかな？ 57' dates.Activate 58' 59' 'ファイル名取得 60' Dim sPath As String, buf2 As String, cnt As Long 61' With Application.FileDialog(msoFileDialogFolderPicker) ' ▲ 62' If .Show <> True Then Exit Sub ' ▲ 63' sPath = .SelectedItems(1) ' ▲ 64' End With ' ▲ 65' 66' buf2 = Dir(sPath & "\*.*") 67' Do While buf2 <> "" 68' cnt = cnt + 1 69' Cells(cnt + 12, 2) = buf 70' buf2 = Dir() 71' Loop 72 73 ' こうかな？ 74 dates.Activate 75 76End Sub 77 78' [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]] 79' [[ ]] 80' [[ ワークシート名を指定したワークシートの作成 ]] 81' [[ ]] 82' [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]] 83Function CreateWorkSheet(WorkSheetName As String) As Worksheet 84 85 ' 変数定義 86 Dim NewWorkSheet As Worksheet 87 Dim iCheckSameName As Integer 88 89 ' ワークシートの作成 90 ' ※一番最後に挿入 91 Set NewWorkSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count)) 92 93 ' 同じ名前ワークシートが無いか確認 94 iCheckSameName = 0 95 For Each WS In Sheets 96 If WS.Name = WorkSheetName Then 97 MsgBox "ワークシート名：" + WorkSheetName + " この名前は既に使われています。" 98 iCheckSameName = 1 99 End If 100 Next 101 102 '同じ名前のワークシートがなければ 103 If iCheckSameName = 0 Then 104 NewWorkSheet.Name = WorkSheetName 105 Set CreateWorkSheet = NewWorkSheet 106 End If 107 108End Function
投稿2015/02/26 08:42
総合スコア130
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2015/02/27 00:30