| |
▼YUKI さん：
先ほどのコメントを、とりあえずコード化してみました。
Sub CSV結合してBookへ出力()
Dim fs As Object, fd As FileDialog
Dim fStr As String, fName As Variant, i As Integer
Dim iz As Long
'結合するCSVファイルの選択
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = True
.Title = "データ選択（ファイル参照）"
.Filters.Add "テキストファイル", "*.csv"
If .Show = 0 Then Exit Sub
If .SelectedItems.Count < 2 Then
MsgBox "データを複数選んでください"
Exit Sub
End If
End With
'テキストの結合
Set fs = CreateObject("Scripting.FileSystemObject")
iz = fd.SelectedItems.Count
For i = 1 To iz
With fs.OpenTextFile(fd.SelectedItems(i), 1)
fStr = fStr & .ReadAll
.Close
End With
Next i
'結合したテキストの出力
fName = Replace(LCase(fd.SelectedItems(iz)), ".csv", "$.csv")
With fs.CreateTextFile(fName)
.Write fStr
.Close
End With
'結合テキストをワークシートに読み込む
Dim WS As Worksheet
Set WS = Workbooks.Add(6).Worksheets(1)
テキストファイルのインポート fName, WS
fName = Application.GetSaveAsFilename( _
InitialFileName:="ファイル.xls", _
FileFilter:=",*.xls")
If fName = False Then Exit Sub
Application.EnableEvents = False
ActiveWorkbook.SaveAs fName, FileFormat:=xlNormal
Application.EnableEvents = True
End Sub
Sub テキストファイルのインポート(CSVname, ByVal WS As Worksheet)
With WS
With .QueryTables.Add(Connection:= _
"TEXT;" & CSVname, Destination:=WS.Range("A1"))
.Name = "foo"
.FieldNames = True
.AdjustColumnWidth = True
.TextFilePlatform = 932
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
WS.Names(.Name).Delete
.Delete
End With
End With
End Sub
|
|
kanabun
- 09/9/28(月) 17:45 -
