Snasui Excel Forum

Code: Select all

Sub Import()
    Dim rTarget As Range
    Dim i As Integer
    Dim TextFileImport As Variant
    On Error GoTo MsgError
    TextFileImport = Application.GetOpenFilename("Text Files (*.txt),*.txt", , _
           "Select Text Data File", , True)
    For i = 1 To UBound(TextFileImport)
    Set rTarget = Worksheets("School").Range("C65536").End(xlUp).Offset(1, 0)
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & TextFileImport(i), _
        Destination:=rTarget)
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 874
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Next i
    Exit Sub
MsgError:
    MsgBox "Please select a file"
    Exit Sub
End Sub

Code: Select all

Sub Import()
    Dim rTarget As Range
    Dim TextFileImport As String
    TextFileImport = Application.GetOpenFilename("Text Files (*.txt),*.txt", , _
           "Select Text Data File")
    Set rTarget = Worksheets("School").Range("C65536").End(xlUp).Offset(1, 0)
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & TextFileImport, _
        Destination:=rTarget)
                .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 874
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Code: Select all

Sub Macro3()
    Dim FileSaveName As String
    Worksheets("S1").Range("C6:H45").Copy
    Workbooks.Add
    Range("A1").Select
    Selection.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    FileSaveName = Application.GetSaveAsFilename( _
        filefilter:="Text Files (*.txt),*.txt")
    If FileSaveName <> "" Then
        ActiveWorkbook.SaveAs Filename:=FileSaveName, FileFormat:=xlText
        MsgBox "Already save file " & FileSaveName
    End If
    Application.DisplayAlerts = False
    ActiveWindow.Close
    Range("C6").Select
    Application.DisplayAlerts = True
End Sub

Code: Select all

Sub Macro3()
    Dim FileSaveName As String
    Worksheets("S1").Range("C6:H45").Copy
    Workbooks.Add
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   FileSaveName = Application.GetSaveAsFilename(fileFilter:="Text Files (*.txt), *.txt")
     If FileSaveName <> "" Then
        ActiveWorkbook.SaveAs Filename:=FileSaveName
        MsgBox "Already save file " & FileSaveName
    End If
    Application.DisplayAlerts = False
      ActiveWindow.Close
    Range("C6").Select
   Application.DisplayAlerts = True
End Sub