从文本中获取外部数据时提示 Excel 宏中的文件

Question

我们正在使用 AutoCad 实用程序 CleanupScale 2014，我们希望鼓励用户在使用其他人在生产中提供的 CAD 文件之前先运行该实用程序。此实用程序生成的 CSV 日志文件在导入 Excel 时最容易查看，方法是从文本中获取外部数据然后对其进行格式化。我们希望通过 VBA 脚本尽可能多地自动化此过程。

部分问题是要导入的文件并不总是具有相同的文件或工作表名称。

谁能帮助我们编辑下面的 VBA 脚本，以便在继续格式化和过滤之前提示 CSV 文件从中获取文本？

Sub ScaleListCleanupLog()
' ScaleListCleanupLog Macro
' Format the Scale List Cleanup Log for easier viewing.

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\User\Documents\CleanupScales48.csv", Destination:=Range( _
        "$A$1"))
        .Name = "CleanupScales48"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Rows("1:1").Select
    Selection.Font.Bold = True
    Selection.Font.Underline = xlUnderlineStyleSingle
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("B:E").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("E1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$E$24").AutoFilter Field:=5, Criteria1:= _
        "=Error saving drawing", Operator:=xlOr
End Sub

Answer 1

如果我理解正确（而且我可能完全不理解），主要问题是返回用户选择的 CSV 的路径？

Dim myObj As Object
Set myObj = Application.FileDialog(msoFileDialogOpen)
myObj.Show
Dim myDirString As String
myDirString = myObj.SelectedItems(1)
MsgBox myDirString

消息框仅用于测试 - 在此之后，用户已选择文件，您可以使用 myDirString 替换该文件路径。抱歉，如果这不是您要找的东西

Edit1： 回答 OP 关于代码放置位置的评论。添加了预期Cancel 的例程。
另外我使用msoFileDialogFilePicker 而不是msoFileDialogOpen，所以我可以设置CSV File Filter。 Edit2： 团队合作 - 试试这个，看看它是否运行没有错误？它与您的原始代码完全相同，但我们添加了允许用户选择文件的文件对话框浏览器，然后我们将您拥有的硬编码目录替换为从文件对话框浏览器返回的文件目录。这应该（可能）正常工作 编辑3： 仅仅因为这也帮助我学习了一些东西，所以添加了一行 - " .InitialFileName = "C:\Users\" & Environ$("Username") & ".domain\Documents"" 应该更改默认目录

 Sub ScaleListCleanupLog()
' ScaleListCleanupLog Macro
' Format the Scale List Cleanup Log for easier viewing.

Dim myObj As Object
Dim myDirString As String

Set myObj = Application.FileDialog(msoFileDialogFilePicker)

With myObj
    .InitialFileName = "C:\Users\" & Environ$("Username") & ".domain\Documents"
    .Filters.Add "Comma Delimited Files", "*.csv"
    .FilterIndex = 1
    If .Show = False Then MsgBox "Please select CSV file.", vbExclamation: Exit Sub
    myDirString = .SelectedItems(1)
End With

With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;" & myDirString, Destination:=Range("$A$1"))
     .Name = "CleanupScales48"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 1252
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
'rest of the formatting codes here
Rows("1:1").Select
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
Columns("B:E").Select
With Selection
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
Range("E1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$E$24").AutoFilter Field:=5, Criteria1:= _
    "=Error saving drawing", Operator:=xlOr
End Sub

Answer 2

试试这个：

Dim myfile

myfile = Application.GetOpenFileName("Comma Delimited Files, *.csv")

If myfile <> False Then

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & myfile, Destination:=Range("$A$1"))
        '~~> rest of your code here
    End With
Else
    MsgBox "Please select CSV file.", vbExclamation: Exit Sub
End If
'~~>Then your formatting codes here

希望这会有所帮助。