zoukankan      html  css  js  c++  java
  • 20170912xlVBA批量导入txt文件

    Public Sub BatchImportTextFiles()
        AppSettings
        
        'On Error GoTo ErrHandler
        
        Dim StartTime, UsedTime As Variant
        StartTime = VBA.Timer
        '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
        Dim wb As Workbook
        Dim Sht As Worksheet
        Dim OpenWb As Workbook
        Dim OpenSht As Worksheet
        Const SHEET_INDEX = 1
        Const HEAD_ROW As Long = 1
        Dim oSht As Worksheet
        
        Dim FolderPath As String
        Dim FileName As String
        Dim FileCount As Long
        
        
        '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
        Set wb = Application.ThisWorkbook
        Set Sht = wb.Worksheets("汇总")
        Sht.UsedRange.Offset(1).ClearContents
        
        Set oSht = wb.Worksheets("Temp")
        
        
        FolderPath = wb.Path & ""
        FileCount = 0
        FileName = Dir(FolderPath & "*.txt*")
        Do While FileName <> ""
            filepath = FolderPath & FileName
            Debug.Print filepath
            oSht.Cells.ClearContents
            With oSht.QueryTables.Add(Connection:= _
                "TEXT;" & filepath, Destination:=oSht.Range("A1"))
            '.CommandType = 0
            .Name = Replace(FileName, ".txt", "")
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 936
            .TextFileStartRow = 1
            .TextFileParseType = xlFixedWidth
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1)
            .TextFileFixedColumnWidths = Array(5, 11, 9, 8, 14)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        
        
        oSht.UsedRange.Offset(1).Copy Sht.Cells(Sht.Cells.Rows.Count, 1).End(xlUp).Offset(1)
        
        
        
        FileName = Dir
    Loop
    '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
    UsedTime = VBA.Timer - StartTime
    Debug.Print "UsedTime :" & Format(UsedTime, "#0.0000 Seconds")
    'MsgBox "UsedTime :" & Format(UsedTime, "#0.0000 Seconds")
    
    
    ErrorExit:
    Set wb = Nothing
    Set Sht = Nothing
    Set OpenWb = Nothing
    Set OpenSht = Nothing
    Set Rng = Nothing
    
    
    AppSettings False
    Exit Sub
    '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
    ErrHandler:
    If Err.Number <> 0 Then
        MsgBox Err.Description & "!", vbCritical, " QQ 84857038"
        'Debug.Print Err.Description
        Err.Clear
        Resume ErrorExit
    End If
    End Sub
    
    Public Sub AppSettings(Optional IsStart As Boolean = True)
        Application.ScreenUpdating = IIf(IsStart, False, True)
        Application.DisplayAlerts = IIf(IsStart, False, True)
        Application.Calculation = IIf(IsStart, xlCalculationManual, xlCalculationAutomatic)
        Application.StatusBar = IIf(IsStart, ">>>>>>>>Macro Is Running>>>>>>>>", False)
    End Sub
    

      

  • 相关阅读:
    常用模块汇总
    day 16 常用模块 time 和 datetime(1)
    二分法 函数式 模块
    day 15 模块 (3)
    vue require.context 检索文件夹内文件路径
    Node.js搭建本地服务,读取css/js/img/html等各种格式文件
    Nodejs搭建web服务器
    el-table横向滚动条固定在屏幕最下方显示
    IE浏览器 backspace键使浏览器回退
    vue ElementUI el-input 键盘enter事件 导致刷新表单问题
  • 原文地址:https://www.cnblogs.com/nextseven/p/7513352.html
Copyright © 2011-2022 走看看