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
    

      

  • 相关阅读:
    (转)水经注谷歌地图的级别与对应比例尺及分辨率探究
    oracle 单表导出导入
    案例情景--在一次Oracle 数据库导出时 EXP-00008;ORA-00904:EXP-00000: oracle不同版本导入导出规则
    权衡微服务
    ASP.NET Core HTTP 管道中的那些事儿
    ASP.NET Core 中间件之压缩、缓存
    .NET Core 首例 Office 开源跨平台组件(NPOI Core)
    ASP.NET Core 之 Identity 入门(三)
    Entity Framework Core 1.1 升级通告
    ASP.NET Core 1.1.0 Release Notes
  • 原文地址:https://www.cnblogs.com/nextseven/p/7513352.html
Copyright © 2011-2022 走看看