PDA

View Full Version : Solved: Limit FileDialog to only see and open .tsv files



oxicottin
12-19-2012, 04:11 PM
Hello, I wanted to limit opening a FileDialog(msoFileDialogOpen) to only .tsv files and it will only find and show only that format. How and what would I add to the VB below?


Private Sub btnFindImport_Click()

'Workbooks.OpenText Method

'\\Array = If you have 7 columns in your file to convert then you have to use 7 arrays
'Arrays are as follows 1 means denotes import field/column 9 denotes skip field/column

Dim sFullName As String

Application.FileDialog(msoFileDialogOpen).Show
On Error Resume Next
sFullName = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
On Error GoTo 0
If sFullName = "" Then
Me.imgNoSort.Visible = True
Me.cmdSortOrder.Enabled = False
Me.imgSortAscend.Visible = False
Me.imgSortDescend.Visible = False

'Woops You closed the dialog box run activate so sort images dont show if no data.
Call Userform_Activate
Exit Sub
End If

With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & sFullName, Destination:=Range("$A$1"))
.Name = "sFullName"
.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
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 9, 1, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False

End With

'Now lets strip the commas and change ft to ' and in "
Cells.Replace What:=",", Replacement:="", LookAt:=xlPart, MatchCase:=False
Cells.Replace What:=" ft", Replacement:="'", LookAt:=xlPart, MatchCase:=False
Cells.Replace What:=" in", Replacement:="""", LookAt:=xlPart, MatchCase:=False

'Now get rid of the unnessary wording using sheet PhraseDelete
Dim c As Range, rng As Range

Set rng = Worksheets("PhraseDelete").Range("B2:B200")
For Each c In rng
Worksheets("Sheet1").Columns("B").Replace _
What:=c.Value, Replacement:="", _
LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False

Next c

'Now lets delete the item rows we dont want using the sheet PhraseDelete
Dim LR As Long, i As Long
With Sheets("Sheet1")
LR = .Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 1 Step -1
If IsNumeric(Application.Match(.Range("A" & i).Value, Sheets("PhraseDelete").Columns("A"), 0)) Then .Rows(i).Delete
Next i
End With

Columns("A:B").EntireColumn.AutoFit

Me.cmdSortOrder.Enabled = True
Me.imgSortAscend.Enabled = True
Me.imgSortDescend.Enabled = True
Me.imgNoSort.Visible = False

'Call module MatchingProfile to match steel and paper with product
ImportMatches

'Call click to sort the new list
Call cmdSortOrder_Click

'Auto fit the new columns A,B
Columns("A:B").EntireColumn.AutoFit

'Auto fit the new columns C,D
Columns("C:D").EntireColumn.AutoFit

'Set focus to Cell in the .Range
Worksheets("Sheet1").Range("A1").Select

End Sub

p45cal
12-19-2012, 06:06 PM
try replacing:Application.FileDialog(msoFileDialogOpen).showwith:
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "tsv files", "*.tsv"
.Show
End With

oxicottin
12-19-2012, 06:19 PM
thanks p45cal that worked thank you, I tried that but couldn't get it to work earlier... I took out the .show though and it appears that's what I needed to get it working. Thanks again!