Hàm lấy dữ liệu từ file text vào Excel và ghi từ Excel sang file text - API

Liên hệ QC

Kiều Mạnh

I don't program, I beat code into submission!!!
Tham gia
9/6/12
Bài viết
5,421
Được thích
4,033
Giới tính
Nam
1/ ý tưởng bắt đầu có từ chủ đề sau nói rồi thì cũng không nhắc lại nữa cho nhọc ra

2/ Phát sinh 1 tí dữ liệu Txt Có BOM chủ đề sau

3/ Trên Cở sở viết 1 số Hàm tiện ích có hổ trợ Unicode Path và mô phỏng theo 1 số hàm có trong Scripting.FileSystemObject của Ms

Tôi xuất vài Hàm API Demo cho ai tò mò thử chút .... Như Mô tả theo mục số 2 của chủ đề đó = làm biếng viết lắm

Code rất đơn giản là lấy dữ liệu File Txt và ghi vào nó như sau

Mã:
Option Explicit
Rem ----------------------------
Dim FilePath As String
Dim ListFiles() As String, ObjFile As Variant
Dim i As Long, aText As String
Rem ----------------------------
Sub GetData_TxtToArray()
    Dim Res(1 To 1048575, 1 To 1), k As Long
    Rem ----------
    FilePath = ThisWorkbook.Path & "\DataTxt.txt"
    Rem ----------
    Dim t@: t = msTimer
    ActiveSheet.UsedRange.ClearContents
    Rem ----------
    ListFiles = TxtToArrayA(FilePath)
    Rem ----------
    For Each ObjFile In ListFiles
    Rem For i = i To UBound(ListFiles)
        Rem Debug.Print ListFiles(i)
        Rem Debug.Print ObjFile
        k = k + 1
        Res(k, 1) = ObjFile
    Next
    If k Then
        ActiveSheet.[A3].Resize(k) = Res
        ActiveSheet.Range("D1").Value = msTimer - t
    End If
End Sub
Rem ----------------------------
Sub Select_GetData_TxtToArray()
    Dim Res(1 To 1048575, 1 To 1), k As Long
    Rem ----------
    FilePath = GetOpenFilename$
    On Error GoTo thoat
    Rem ----------
    Dim t@: t = msTimer
    ActiveSheet.UsedRange.ClearContents
    Rem ----------
    ListFiles = TxtToArrayA(FilePath)
    Rem ----------
    For Each ObjFile In ListFiles
    Rem For i = i To UBound(ListFiles)
        Rem Debug.Print ListFiles(i)
        Rem Debug.Print ObjFile
        k = k + 1
        Res(k, 1) = ObjFile
    Next
    If k Then
        ActiveSheet.[A3].Resize(k) = Res
        ActiveSheet.Range("D1").Value = msTimer - t
    End If
thoat:     Exit Sub
End Sub
Rem ----------------------------
Sub Main_WriteLineToTxtA()
    FilePath = ThisWorkbook.Path & "\DataTxt.txt"
    Rem ----------
    Dim t@: t = msTimer
    Rem ----------
    For i = 1 To 104 '8570 ''999999999
        aText = Sheet3.Range("A1").Value & Space(3) & i
        Rem Debug.Print xx
        Call WriteLineToTxtA(FilePath, aText)
    Next
    Range("D1").Value = msTimer - t
End Sub
Rem ----------------------------
Sub Mian2_WriteLineToTxtA()
    FilePath = ThisWorkbook.Path & "\DataTxt.txt"
    Call WriteLineToTxtA(FilePath, Sheet3.Range("A1").Value)
End Sub
Rem ----------------------------

Code mẫu đơn giản nhất cho các bạn mới tập tành code đọc nó ... còn Hàm lấy kiểu tùy biến lấy lên 1 Array còn lại xử lý sao thì tùy ai đó vận dụng nó
 

File đính kèm

  • FileSystemAPI.rar
    1.3 MB · Đọc: 21
Em mở thì bị lỗi này không rõ thiếu thư viện gì anh nhỉ
 

File đính kèm

  • Untitled.jpg
    Untitled.jpg
    111.1 KB · Đọc: 29
Web KT
Back
Top Bottom