Consulting

Results 1 to 3 of 3

Thread: Solved: Limit FileDialog to only see and open .tsv files

  1. #1

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

    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?


    [VBA]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").EntireColumn.AutoFit

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

    End Sub[/VBA]

  2. #2
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,876
    try replacing:[VBA]Application.FileDialog(msoFileDialogOpen).show[/VBA]with:
    [VBA] With Application.FileDialog(msoFileDialogOpen)
    .Filters.Clear
    .Filters.Add "tsv files", "*.tsv"
    .Show
    End With[/VBA]
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  3. #3
    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!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •