How to choose a file to perform a macro on

[goksufan]

I have macro written that i want to repeat on several text files. How can i have the macro prompt me to select the file I want ? My Macro is as follows:

Sub Import()

' Import Macro
'
' Keyboard Shortcut: Ctrl+a
'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;Z:\Davids\File layouts\DSPFILER_18_3_12_10_41_57.TXT", Destination:= _
Range("$A$1"))
.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 = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2)
.TextFileFixedColumnWidths = Array(11, 9, 5, 4, 5, 48, 13, 11)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("J1").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(RC[-9],RC[-8],RC[-7]&"" "",RC[-6],RC[-5]&"" "",RC[-4])"
Columns("J:J").EntireColumn.AutoFit
Range("J2").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(RC[-9],RC[-8]&"" "",RC[-7],RC[-6],RC[-5]&"" "",RC[-4])"
Range("J3").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(RC[-9],RC[-8],RC[-7],RC[-6]&"" "",RC[-5],RC[-4])"
Range("J1:J3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1:I3").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Columns("A:A").EntireColumn.AutoFit
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(9, 1), Array(19, 1), Array(28, 1), Array(55, 1), _
Array(67, 1)), TrailingMinusNumbers:=True
Columns("C:C").EntireColumn.AutoFit
Range("A2").Select
Selection.TextToColumns Destination:=Range("A2"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(13, 1), Array(36, 1)), TrailingMinusNumbers _
:=True
Range("A3").Select
Selection.TextToColumns Destination:=Range("A3"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(12, 1), Array(22, 1), Array(31, 1)), _
TrailingMinusNumbers:=True
Range("B3").Select
ActiveCell.FormulaR1C1 = "=-FABREAB"
Range("B3").Select
ActiveCell.FormulaR1C1 = "FABREAB"
Range("B4").Select
End Sub

 

[ranman256]

usage:
vFile = UserPick1File("c:\folder")
if vFile <> "" then RunThis

Public Function UserPick1File(pvPath)
Dim strTable As String
Dim strFilePath As String
Dim sDialog As String, sDecr  As String, sExt As String


If IsMissing(pvPath) Then pvPath = "c:\"


With Application.FileDialog(msoFileDialogFilePicker)   'MUST ADD REFERENCE : Microsoft Office 11.0 Object Library
    .AllowMultiSelect = False
    .Title = "Locate a file to Import"
    .ButtonName = "Import"
    .Filters.Clear
    .Filters.Add sDecr, sExt
    .InitialFileName = pvPath
    .InitialView = msoFileDialogViewList    'msoFileDialogViewThumbnail


        If .show = 0 Then
           'There is a problem
           Exit Function
        End If


    'Save the first file selected
    UserPick1File = Trim(.SelectedItems(1))
End With
End Function