複数のtxtファイルからデータをインポートする方法

Question

私はまだvbaを新しく導入しており、データのインポートに関して質問があります。テキストファイルからデータをインポートして転記するには、以下のコード（下記）を用意していますが、fx 5個のファイルをハイライト表示してからインポートするといいでしょう。私は複数選択が必要だと思いますが、選択したすべてのファイルを実行するにはどうすればよいですか？

希望すると医師を助けることができます。

よろしく

ロニー

FILOPEN = Application.GetOpenFilename("Files (*.txt; *.jpg; *.bmp; 

*.tif),*.chr; *_chr.txt; *chr.txt; *.tif", _ 
, "Select Picture to Import") 
On Error GoTo LastLine 

Application.ScreenUpdating = False 
    Workbooks.OpenText Filename:=FILOPEN, _ 
    Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ 
     xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _ 
     Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _ 
     TrailingMinusNumbers:=True 

'name of file that is imported from 
Dim z As String 

z = ActiveWorkbook.Name 
Windows(Left(z, Len(z))).Activate 

'Copy Data 
Range("c1").Select 

    Selection.End(xlDown).Select 
    ActiveCell.Offset(1, 0).Range("A1").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy 


Windows(Left(f, Len(f))).Activate 'name of file that is imported into (original sheet) 

    ActiveCell.Offset(0, 1).Range("A1").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=True 

    Selection.End(xlToLeft).Select 
    ActiveCell.Offset(0, 0).Range("A1").Select 

Answer 1

複数のファイルを選択するためにあなたのApplication.GetOpenFilename方法にMultiSelect:=Trueを追加します。

If IsArray(FILOPEN) Then 
    For I = LBound(FILOPEN) To UBound(FILOPEN) 
     Workbooks.OpenText Filename:=FILOPEN(I) ... 
     ... 
     ... 
     ... 
    Next I 
End If 

：

FILOPEN = Application.GetOpenFilename(_ 
FileFilter:="Files (*.txt; *.jpg; *.bmp; *.tif), *.chr; *_chr.txt; *chr.txt; *.tif", _ 
Title:="Select Picture to Import", _ 
MultiSelect:=True) 

が続いた結果の配列を反復処理

Answer 2

以下のスクリプトはすべてのテキストファイルをインポートします。もちろん、Taosiqueのように複数のファイルを選択することもできます。すべてのファイルをインポートする場合は、以下のコードを実行します。

Sub Import_All_Text_Files_2007() 

    Dim nxt_row As Long 

    'Change Path 
    Const strPath As String = "enter_your_path_here\" 
    Dim strExtension As String 

    'Stop Screen Flickering 
    Application.ScreenUpdating = False 

    ChDir strPath 

    'Change extension 
    strExtension = Dir(strPath & "*.txt") 

    Do While strExtension <> "" 

     'Adds File Name as title on next row 
     Range("A65536").End(xlUp).Offset(1, 0).Value = strExtension 

     'Sets Row Number for Data to Begin 
     nxt_row = Range("A65536").End(xlUp).Offset(1, 0).Row 

     'Below is from a recorded macro importing a text file 
     With ActiveSheet.QueryTables.Add(Connection:= _ 
      "TEXT;" & strPath & strExtension, Destination:=Range("$A$" & nxt_row)) 
      .Name = strExtension 
      .FieldNames = True 
      .RowNumbers = False 
      .FillAdjacentFormulas = False 
      .PreserveFormatting = True 
      .RefreshOnFileOpen = False 
      .RefreshStyle = xlInsertDeleteCells 
      .SavePassword = False 
      .SaveData = True 
      .AdjustColumnWidth = True 
      .RefreshPeriod = 0 
      .TextFilePromptOnRefresh = False 
      .TextFilePlatform = 850 
      .TextFileStartRow = 1 
      .TextFileParseType = xlDelimited 
      .TextFileTextQualifier = xlTextQualifierDoubleQuote 
      'Delimiter Settings: 
      .TextFileConsecutiveDelimiter = True 
      .TextFileTabDelimiter = True 
      .TextFileSemicolonDelimiter = True 
      .TextFileCommaDelimiter = True 
      .TextFileSpaceDelimiter = True 
      .TextFileOtherDelimiter = "=" 

      .TextFileTrailingMinusNumbers = True 
      .Refresh BackgroundQuery:=False 
     End With 

     strExtension = Dir 
    Loop 

    Application.ScreenUpdating = True 

End Sub