Question

我们正在使用AutoCad实用程序CleanupScale 2014，我们希望在使用生产中其他人提供的CAD文件之前鼓励用户运行。通过从文本中获取外部数据然后对其进行格式化，导入到Excel时，最简单地查看此实用程序生成的CSV日志文件。我们希望通过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替换该文件路径。如果这不是您正在寻找的话，请道歉

编辑1：回答OP关于放置代码的位置的评论。添加例程以预测Cancel。
另外，我使用msoFileDialogFilePicker代替msoFileDialogOpen，因此我可以设置CSV File Filter。 编辑2：团队合作 - 尝试这一点，看看它是否正常运行？它与原始代码完全相同，但我们添加了文件对话框浏览器，允许用户选择文件，然后我们用文件对话框浏览器返回的文件目录替换了硬编码目录。这应该（可能）没有错误地工作的 EDIT3：仅仅因为这有助于我学习一些东西，添加一行 - ＆＃34; .InitialFileName =＆＃34; C：\ Users \＆＃34; ＆安培; Environ $（＆＃34;用户名＆＃34;）＆amp; ＆＃34;。域\文件＆＃34;＆＃34;这应该改变默认目录

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

希望这有帮助。

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

2 个答案: