UPDATED CODE AND ISSUES (5/9/2018 1:53PM Eastern)
I am encountering problems trying to import multiple data text files into a fixed worksheet (“Raw Data”) using two different delimiters. I am using Application.GetOpenFilename to allow the user to select multiple text files from a folder. The files contain a header row which is semicolon delimited, then several lines of data which is comma delimited. In a single text file, this format can be repeated several times (this is an inspection log file which records and appends data to the same text file for each inspection run, i.e. header line1, some rows of data, header line 2, more rows of data, header line 3, more rows of data, etc.)
I’ve tried a few approaches to solve this based on other examples I’ve found on StackOverflow.com but I can’t seem to successfully mesh the solutions together to come up with a solution that imports single or multiple text files with two different delimiters within each file. I cannot change the format or content of the original text files, so I can’t search and replace different delimiters to a single delimiter.
Here are the remaining issues I’m running into with the attached VBA code:
When importing more than one text file, a blank line is inserted between the files which breaks the .TextToColumns section. It is also asking to replace existing data when importing the second file selected. Is there a more efficient or better way to import data from multiple text files using both commas and semicolons as delimiters?
Within a fixed path on the local hard drive, each new order number creates a new sub-folder to store .txt data files (i.e. C:\AOI_DATA64\SPC_DataLog\IspnDetails\123456-7). Is there a way the user can be prompted to enter a sub-folder name (123456-7) and the VBA script will automatically import all .txt files from this sub-folder, rather than using Application.GetOpenFilename?
Here is a truncated version of one of the data files I’m trying to import. The actual file does not have spaces between the rows of data. I separated them in this example to clearly show each line in the text file.
[StartIspn];Time=04/19/18 12:43:15;User=yeseniar;MachineID=WINDOWS-TEFJCS1;Side=T;DoubleSided;IsOnline=1;IA_Idx=1;SN_Idx=0;IT=0;SPC_Db=1;SPC_Txt=1;TxtFmt=10;E_Rpt=1;D_Img=1;FeedMode=0; KC17390053F,VIA5F,M North,A8,85.0,45.0,96.0,23.2,9.9,0.0,0.0,0.0,59.0,0.0,0.0,0.0, KC17390053F,VIA3F,M North,A8,85.0,45.0,96.0,22.3,22.9,0.0,0.0,0.0,59.0,0.0,0.0,0.0, KC17390053F,FMI1F,S South,A13,12.3,0.0,1.0,3.5,3.5,0.0,0.0,0.0,0.0,0.0,0.0,0.0, KC17390053F,FMI13F,S South,A13,12.3,0.0,1.0,3.5,3.5,0.0,0.0,0.0,0.0,0.0,0.0,0.0, [StartIspn];Time=04/19/18 14:28:10;User=yeseniar;MachineID=WINDOWS-TEFJCS1;Side=B;DoubleSided;IsOnline=1;IA_Idx=1;SN_Idx=0;IT=0;SPC_Db=1;SPC_Txt=1;TxtFmt=10;E_Rpt=1;D_Img=1;FeedMode=0; KC17390066B,VIA5B,M North,A8,70.0,50.0,92.0,-38.8,-3.7,0.0,0.0,0.0,50.0,0.0,0.0,0.0, KC17390066B,VIA6B,M North,A8,70.0,50.0,93.0,-37.7,-23.6,0.0,0.0,0.0,50.0,0.0,0.0,0.0, KC17390066B,FMI12B,S South,A13,4140.4,0.0,2.0,3.5,129.6,0.0,0.0,0.0,0.0,0.0,0.0,0.0, KC17390066B,FMI24B,S South,A13,2128.7,0.0,2.0,3.5,119.1,0.0,0.0,0.0,0.0,0.0,0.0,0.0,
Here is what I have so far for importing multiple text files:
Sub Import_DataFile() ' Add an error handler On Error GoTo ErrorHandler ' Speed up this sub-routine by turning off screen updating and auto calculating until the end of the sub-routine Application.ScreenUpdating = False Application.Calculation = xlCalculationManual ' Define variable names and types Dim OpenFileName As Variant Dim i As Long Dim n1 As Long Dim n2 As Long Dim fn As Integer Dim RawData As String Dim rngTarget As Range Dim rngFileList As Range Dim TargetRow As Long Dim FileListRow As Long Dim dLastRow As Long Dim destCell As Range ' Select the source folder and point list file(s) to import into worksheet OpenFileName = Application.GetOpenFilename( _ FileFilter:="AOI Inspection Results Data Files (*.txt), *.txt", _ Title:="Select a data file or files to import", _ MultiSelect:=True) ' Import user selected file(s) to "Raw Data" worksheet TargetRow = 0 Set destCell = Worksheets("Raw Data").Range("B1") For n2 = LBound(OpenFileName) To UBound(OpenFileName) fn = FreeFile Open OpenFileName(n2) For Input As #fn Application.StatusBar = "Processing ... " & OpenFileName(n2) Do While Not EOF(fn) Line Input #fn, RawData TargetRow = TargetRow + 1 Worksheets("Raw Data").Range("B" & TargetRow).Formula = RawData Loop Next n2 Close #fn Set rngTarget = Worksheets("Raw Data").Range("B1" & ":" & Worksheets("Raw Data").Range("B1").End(xlDown).Address) With rngTarget .TextToColumns Destination:=destCell, DataType:=xlDelimited, _ TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=True, Comma:=True, Space:=False, Other:=False, OtherChar:="|", _ FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True End With Else: MsgBox "The selected file is not the correct format for importing data." Exit Sub End If Next ' Create a number list (autofill) in Col A to maintain original import sort order dLastRow = Worksheets("Raw Data").Cells(Rows.Count, "B").End(xlUp).Row Worksheets("Raw Data").Range("A1:A" & dLastRow).Font.Color = RGB(200, 200, 200) Worksheets("Raw Data").Range("A1") = "1" Worksheets("Raw Data").Range("A2") = "2" Worksheets("Raw Data").Range("A1:A2").AutoFill Destination:=Worksheets("Raw Data").Range("A1:A" & dLastRow), Type:=xlFillDefault Worksheets("Raw Data").Range("F1:Q" & dLastRow).NumberFormat = "0.0" ' Auto fit the width of columns for RAW Data Worksheets("Raw Data").Columns("A:Z").EntireColumn.AutoFit ' Turn screen updating and auto calculating back on since file processing is now complete Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic ' Reset to defaults in the event of a processing error during the sub-routine execution ErrorHandler: Application.StatusBar = False Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic If Err.Number <> 0 Then ' Display a message to the user including the error code in the event of an error during execution MsgBox "An error number " & Err.Number & " was encountered!" & vbNewLine & _ "Part or all of this VBA script was not completed.", vbInformation, "Error Message" End If End Sub
Many questions… Let me give some hints.
Prompting the user for working directory :
Dim fDlg As FileDialog ' dialog box object Dim sDir As String ' selected path Dim iretval As Long ' test Set fDlg = Application.FileDialog(msoFileDialogFolderPicker) sDir = conDEFAULTPATH ' init With fDlg .Title = "Select a Folder" .AllowMultiSelect = False .InitialFileName = sDir iretval = .Show If iretval = -1 Then sDir = .SelectedItems(1) End With Set fDlg = Nothing ' drop object If sDir = vbNullString Then MsgBox "Invalid directory" Else If Right$(Trim$(sDir), 1) <> Application.PathSeparator Then _ sDir = Trim$(sDir) & Application.PathSeparator' append closing backslash to pathname End If
Collecting files to a buffer
Dim FileBuf(100) as string, FileCnt as long FileCnt=0 FileBuf(FileCnt)=Dir(sDir & "*.txt") Do While FileBuf(FileCnt) <> vbnullstring FileCnt = FileCnt + 1 FileBUf(FileCnt) = Dir Loop
Reducing number of delimiters: simply use replace
RawData = Replace(RawData, ";", ",")
For the blank line I have no clue, though it might be a result of a blank line in the source file, maybe the EOF. So what if you check the line before copying:
If len(trim(RawData)) > 0 Then TargetRow = TargetRow + 1 Worksheets("Raw Data").Range("B" & TargetRow) = RawData End If
Please note that I’ve removed
.Formula. You are working with values.
For setting target range: You should omit
.Address. For selecting last cell in a range, you should use
Set rngTarget = Worksheets("Raw Data").Range("B1" & ":" & Worksheets("Raw Data").Range("B1").End(xlUp))
I prefer using direct cell references, so – as you exactly know the last row – I would do it this way:
Set rngTarget = Worksheets("Raw Data").Range(Cells(1, 2), Cells(TargetRow, 2))