複数のファイルを1つのブックにインポートする（Microsoft Excel）

Sub CombineTextFiles()

Dim FilesToOpen     Dim x As Integer     Dim wkbAll As Workbook     Dim wkbTemp As Workbook     Dim sDelimiter As String

On Error GoTo ErrHandler     Application.ScreenUpdating = False

sDelimiter = "|"



FilesToOpen = Application.GetOpenFilename _       (FileFilter:="Text Files (.txt), .txt", _       MultiSelect:=True, Title:="Text Files to Open")



If TypeName(FilesToOpen) = "Boolean" Then         MsgBox "No Files were selected"

GoTo ExitHandler     End If

x = 1     Set wkbTemp = Workbooks.Open(FileName:=FilesToOpen(x))

wkbTemp.Sheets(1).Copy     Set wkbAll = ActiveWorkbook     wkbTemp.Close (False)

wkbAll.Worksheets(x).Columns("A:A").TextToColumns _       Destination:=Range("A1"), DataType:=xlDelimited, _       TextQualifier:=xlDoubleQuote, _       ConsecutiveDelimiter:=False, _       Tab:=False, Semicolon:=False, _       Comma:=False, Space:=False, _       Other:=True, OtherChar:="|"

x = x + 1

While x <= UBound(FilesToOpen)

Set wkbTemp = Workbooks.Open(FileName:=FilesToOpen(x))

With wkbAll             wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)

.Worksheets(x).Columns("A:A").TextToColumns _               Destination:=Range("A1"), DataType:=xlDelimited, _               TextQualifier:=xlDoubleQuote, _               ConsecutiveDelimiter:=False, _               Tab:=False, Semicolon:=False, _               Comma:=False, Space:=False, _               Other:=True, OtherChar:=sDelimiter         End With         x = x + 1     Wend

ExitHandler:

Application.ScreenUpdating = True     Set wkbAll = Nothing     Set wkbTemp = Nothing     Exit Sub

ErrHandler:

MsgBox Err.Description     Resume ExitHandler End Sub

Sub LoadPipeDelimitedFiles()

Dim idx As Integer     Dim fpath As String     Dim fname As String

idx = 0     fpath = "c:\temp\load_excel\"

fname = Dir(fpath & "*.txt")

While (Len(fname) > 0)

idx = idx + 1         Sheets("Sheet" & idx).Select         With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _           & fpath & fname, Destination:=Range("A1"))

.Name = "a" & idx             .FieldNames = True             .RowNumbers = False             .FillAdjacentFormulas = False             .PreserveFormatting = True             .RefreshOnFileOpen = False             .RefreshStyle = xlInsertDeleteCells             .SavePassword = False             .SaveData = True             .AdjustColumnWidth = True             .RefreshPeriod = 0             .TextFilePromptOnRefresh = False             .TextFilePlatform = 437             .TextFileStartRow = 1             .TextFileParseType = xlDelimited             .TextFileTextQualifier = xlTextQualifierDoubleQuote             .TextFileConsecutiveDelimiter = False             .TextFileTabDelimiter = False             .TextFileSemicolonDelimiter = False             .TextFileCommaDelimiter = False             .TextFileSpaceDelimiter = False             .TextFileOtherDelimiter = "|"

.TextFileColumnDataTypes = Array(1, 1, 1)

.TextFileTrailingMinusNumbers = True             .Refresh BackgroundQuery:=False             fname = Dir         End With     Wend End Sub