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
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