エクセル マクロ

質問

以下のコードではテキスト(ｔｘｔ)ファイルのデータをエクセルへ貼りつけるものですが
貼りつけるテキストファイルを参照し選ぶ際、
テキストファイル以外を選ぶとエラーが起きてしまいます
テキストファイル以外を選んで実行した場合は
メッセージボックスを表示するようにはどうすればよいですか？

Private Sub CommandButton1_Click()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim vrtSelectedItem As Variant
With fd
Dim txtpass As Variant
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
txtpass = "TEXT;" & vrtSelectedItem
Next vrtSelectedItem
Else
MsgBox "キャンセルされました"
Exit Sub
End If
End With
With ActiveSheet.QueryTables.Add(Connection:= _
txtpass, Destination:=Cells(Rows.Count, 2).End(xlUp).Offset(2, 0))
.Name = "4"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 932
.TextFileStartRow = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

回答No.1

mt2008 · ベストアンサー

お好きな方、あるいは両方実装を……

案1.txtしか選択肢に表示させない（メッセージなし）

With fd
Dim txtpass As Variant
↓
With fd
　　.Filters.Add "テキストファイル", "*.txt"
Dim txtpass As Variant

案2.拡張子だけ見て判断

For Each vrtSelectedItem In .SelectedItems
　　txtpass = "TEXT;" & vrtSelectedItem
Next vrtSelectedItem
　↓
For Each vrtSelectedItem In .SelectedItems
　　If UCase(Right(vrtSelectedItem, 4)) <> ".TXT" Then
　　　　MsgBox "txt以外が選択されています"
　　　　Exit Sub
　　Else
　　　　txtpass = "TEXT;" & vrtSelectedItem
　　End If
Next vrtSelectedItem

お礼

早急に回答して頂いて助かりました
ありがとうございました