CODEWITHSUNDEEP
vbaexcelcsvimport
blugirl
blugirl

Reputation: 35

Prompt for file in Excel Macro when getting external data from text

We're using an AutoCad utility, CleanupScale 2014, that we want to encourage users to run before using CAD files provided by others in production. The CSV log file generated by this utility is easiest viewed when imported into Excel by getting external data from text then formatting it. We'd like to automate as much of this process via a VBA script.

Part of the problem is that the file to import doesn't always have the same file or sheet name.

Can anyone help us with editing the below VBA script so that it will prompt for the CSV file to get the text from before continuing on with the formatting & filtering?

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

Upvotes: 2

Views: 2742

Answers (2)

Acantud
Acantud

Reputation: 508

If I understand right (And I may be completely off) the main problem is returning the path of the CSV that the user selects?

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

The messagebox is just for testing - after this point, the user has selected the file, and you can use myDirString to replace that file path. Apologies if this isnt what you're looking for

Edit1: To answer OP's comment on where to put the code. Added routine to anticipate Cancel as well.
Also I used msoFileDialogFilePicker instead of msoFileDialogOpen so I can set the CSV File Filter. Edit2: Team effort - try this, and see if it runs without errors? It's the exact same as your original code, but we added the File Dialog browswer which lets a user select a file, then we replaced that hardcoded directory you had with the file directory returned from the File Dialog browser. This should (might) work without error Edit3: Just because this is helping me learn a few things too, added one line - " .InitialFileName = "C:\Users\" & Environ$("Username") & ".domain\Documents"" which should change the default directory

 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

Upvotes: 1

L42
L42

Reputation: 19737

Try this:

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

Hope this helps.

Upvotes: 1

Related Questions