Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.
Sub DoIt() Dim fld As FileDialog Dim sFolderLoc As String Dim iCurrentRow As Long Dim i As Long Dim sTxtFilename As String Dim j As Long Dim sLine As String Dim sComputedResults Dim sComputedMaximum Dim sComputedMinimum With ThisWorkbook.ActiveSheet .Range("A1") = "File Name" .Range("B1") = "Computed Results" .Range("C1") = "Blank" .Range("D1") = "Computed Maximum" .Range("E1") = "Computed Minimum" End With iCurrentRow = 1 'sFolderLoc = ThisWorkbook.ActiveSheet.Cells(2, 9).Value 'Set fld = Application.FileDialog(msoFileDialogFolderPicker) 'open file picker instead of a folder picker Set fld = Application.FileDialog(msoFileDialogFilePicker) 'set file picker dialog preferences With fld .Title = "Pick your file type" .AllowMultiSelect = False 'you may want to comment out the next two lines if you want to allow users to select a variety of file types .Filters.Clear .Filters.Add "Text Files", "*.data" If .Show <> -1 Then GoTo Exit_DoIt sFolderLoc = fld.SelectedItems(1) End With 'sTxtFilename = ThisWorkbook.ActiveSheet.Cells(2, 10).Value 'set file type based upon what the user has selected sTxtFilename = "*." & Right(sFolderLoc, Len(sFolderLoc) - InStrRev(sFolderLoc, ".")) sComputedResults = "Computed Results: " sComputedMaximum = "Computed Maximum: " sComputedMinimum = "Computed Minimum: " 'set folder based upon location of file user has selected sFolderLoc = Left(sFolderLoc, InStrRev(sFolderLoc, "\")) ' this assumes all files of type data are your data sTxtFilename = Dir(sFolderLoc & "\" & sTxtFilename) Do While sTxtFilename <> "" iCurrentRow = iCurrentRow + 1 Open sFolderLoc & "\" & sTxtFilename For Input As #1 ' no error checking here, assumes all txt files are ok Do While Not EOF(1) Input #1, sLine If Left(sLine, Len(sComputedResults)) = sComputedResults Then sLine = Right(sLine, Len(sLine) - Len(sComputedResults)) ThisWorkbook.ActiveSheet.Range("B" & iCurrentRow) = sLine ElseIf Left(sLine, Len(sComputedMaximum)) = sComputedMaximum Then sLine = Right(sLine, Len(sLine) - Len(sComputedMaximum)) ThisWorkbook.ActiveSheet.Range("D" & iCurrentRow) = sLine ElseIf Left(sLine, Len(sComputedMinimum)) = sComputedMinimum Then sLine = Right(sLine, Len(sLine) - Len(sComputedMinimum)) ThisWorkbook.ActiveSheet.Range("E" & iCurrentRow) = sLine End If Loop ThisWorkbook.ActiveSheet.Range("A" & iCurrentRow) = sTxtFilename Close #1 'find next txt file sTxtFilename = Dir Loop Exit_DoIt: Set fld = Nothing End Sub
|Word 2016 - Spelling/Grammar Check - Inconsistent behavior upon completion||7||38|
|Powershell merging excel spreadsheets into one||2||10|
|Use cell value to specify decimal places in Excel||9||0|
Join the community of 500,000 technology professionals and ask your questions.
Connect with top rated Experts
15 Experts available now in Live!