vincentzack
07-21-2016, 05:38 AM
As the title says I need to import multiple text files (all the same format) into an excel spreadsheet. The text files are saved in a folder, e.g. C:\Test. The path can be changed in the excel (like the attached excel, worksheet("Master"), cells (B1))
I want to import some of the text files from the folder (not import all) to separate worksheet. For example: import BEAMA.txt, then excel will have a sheet called BEAMA".
I only have the code to import the text file one by one. However, I need to import 50 nos. of text file out of 200. Could anyone help?
Sub ImportData()
Dim txtFileNameAndPath As String
Dim ImportingFileName As String, ImportingFileName2 As String
Dim SheetName As Worksheet
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
'Enable this option if you want the use to be able to select multiple files
.AllowMultiSelect = False
'This sets the title of the dialog box.
.Title = "Please select the file."
'Sets the associated filters for types of files
.Filters.Clear
.Filters.Add "txt", "*.txt"
.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
txtFileNameAndPath = .SelectedItems(1)
Else
MsgBox "Please start over. You must select a file to import"
'You don't want the sub continuing if there wasn't a file selected
Exit Sub
End If
End With
'Extracts only the file name for reference later
ImportingFileName = Right(txtFileNameAndPath, _
Len(txtFileNameAndPath) - InStrRev(txtFileNameAndPath, "\"))
'Nneed to be on the active worksheet for the below code to work
ImportingFileName2 = Left(ImportingFileName, Len(ImportingFileName) - 4)
ThisWorkbook.Sheets.Add.Name = ImportingFileName2
Worksheets(ImportingFileName2).Activate
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & txtFileNameAndPath _
, Destination:=Worksheets(ImportingFileName2).Range("$A2"))
.Name = "ImportingFileName"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 950
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
I want to import some of the text files from the folder (not import all) to separate worksheet. For example: import BEAMA.txt, then excel will have a sheet called BEAMA".
I only have the code to import the text file one by one. However, I need to import 50 nos. of text file out of 200. Could anyone help?
Sub ImportData()
Dim txtFileNameAndPath As String
Dim ImportingFileName As String, ImportingFileName2 As String
Dim SheetName As Worksheet
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
'Enable this option if you want the use to be able to select multiple files
.AllowMultiSelect = False
'This sets the title of the dialog box.
.Title = "Please select the file."
'Sets the associated filters for types of files
.Filters.Clear
.Filters.Add "txt", "*.txt"
.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
txtFileNameAndPath = .SelectedItems(1)
Else
MsgBox "Please start over. You must select a file to import"
'You don't want the sub continuing if there wasn't a file selected
Exit Sub
End If
End With
'Extracts only the file name for reference later
ImportingFileName = Right(txtFileNameAndPath, _
Len(txtFileNameAndPath) - InStrRev(txtFileNameAndPath, "\"))
'Nneed to be on the active worksheet for the below code to work
ImportingFileName2 = Left(ImportingFileName, Len(ImportingFileName) - 4)
ThisWorkbook.Sheets.Add.Name = ImportingFileName2
Worksheets(ImportingFileName2).Activate
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & txtFileNameAndPath _
, Destination:=Worksheets(ImportingFileName2).Range("$A2"))
.Name = "ImportingFileName"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 950
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub