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

我们使用的是一个AutoCad实用程序CleanupScale 2014，我们希望用户在使用其他人在生产中提供的CAD文件之前运行它。 通过从文本获取外部数据然后格式化该实用工具生成的CSV日志文件，在导入Excel时最容易查看。 我们希望通过VBA脚本自动化这个过程。

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

任何人都可以帮助我们编辑下面的VBA脚本，以便在继续进行格式化和过滤之前，它会提示inputCSV文件来获取文本。

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

如果我理解正确（我可能完全closures）主要问题是返回用户select的CSV的path？

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

该消息框仅用于testing – 在此之后，用户select了该文件，并且可以使用myDirStringreplace该文件path。 道歉，如果这不是你在找什么

编辑1：回答OP对代码放置位置的评论。 添加例程以预期Cancel 。
此外，我用msoFileDialogFilePicker而不是msoFileDialogOpen所以我可以设置CSV File Filter 。 编辑2：团队的努力 – 试试这个，看看它是否运行没有错误？ 这与原始代码完全相同，但是我们添加了文件对话框，让用户select一个文件，然后我们用文件对话框浏览器返回的文件目录replace了你的硬编码目录。 这应该（可能）没有错误的工作Edit3：只是因为这也帮助我学习一些东西，添加一行 – “.InitialFileName =”C：\ Users \“和环境$（”用户名“）＆”.domain \文件“”应该改变默认的目录

  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 

希望这可以帮助。