0

このルーチンを使用して、ファイルまたはフォルダー全体Application.GetOpenFilenameを開きます。*.txtこれはどういうわけか可能ですか？
たとえば、ファイル/フォルダが選択されていない場合は、親のフォルダパスが返されます。それ以外の場合は、選択されたファイル名が返されますか？

"test.txt"例：パスに呼び出されたファイルがあると仮定しますC:\folder1\folder2\test.txt。今、私はファイルを検索してC:\folder1（「親フォルダ」）を選択するのが面倒です。私のプログラムは、サブフォルダー内で。を検索するようになりましたtest.txt。しかし、時々私は怠惰ではなく、特定のファイルを選択したいtest.txt

私は両方を処理するための1つのユーザーフレンドリーなダイアログを探しています：フォルダを開く（そしてフォルダパスのみを返す）とファイルを開く（そしてファイルパスを返す）

4

2 に答える 2

1

parentVBAが呼び出されるファイルを意味すると思います。そうでない場合は、以下を非常に簡単に調整できるはずです。

Sub getFileorFolder()

fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")

If fileToOpen = False Then fileToOpen = ThisWorkbook.Path

MsgBox "File is " & fileToOpen

End Sub
于 2012-10-22T14:08:08.690 に答える
0

テキストファイルを開くより良い方法がありますが、上記の回答のいずれかを利用しています。

Sub ImportTextFile()
'better method to retrieving Data from txt.
If Not Range("A2").Value = "" Then
MsgBox "Clear Data First"
Sheets("Input DATA").Select
Exit Sub
End If

fileToOpen = application.GetOpenFilename("Text Files (*.txt), *.txt")
If fileToOpen = False Then fileToOpen = ThisWorkbook.Path
MsgBox "File is " & fileToOpen

    With ActiveSheet.QueryTables.Add(connection:= _
        "TEXT;" + fileToOpen, Destination:=Range("$A$2"))
        '.name = "All"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
Call RemoveEmptyRows
End Sub

Sub RemoveEmptyRows()
On Error Resume Next
Range("A2:A5000").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp
Resume:
Range("A2").Select
End Sub
于 2015-09-02T18:16:03.623 に答える