code đọc dữ liệu từ file txt

[giaosy]

Xin các bác cho ý kiến về việc lưu toàn bộ nội dung file xls vào trong file txt. Tôi đã thử và thấy tương đối ngon lành. Dung lượng file giảm xuống nhiều, dễ gửi qua mạng, dễ lấy dữ liệu và cũng dễ lưu lại vào file txt đó.

Tôi đã dùng đoạn code này (lợi dụng tính năng importdata và cách định dạng file của excel) để làm:

Sub doc_du_lieu()
Dim tenfile As String
tenfile = InputBox("nhap ten file can doc")
    Range("A1:D3").Select
    Selection.ClearContents
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;E:\" & tenfile & ".txt", _
            Destination :=Range("A1")) 
        .Name = "luu"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Vì tôi mới chập chững nghiên cứu ứng dụng của vba nên đoạn code này vẫn chưa hoàn chỉnh, mong các cao thủ xem hộ lỗi ở đâu ?
Cảm ơn nhiều.

 

[levanduyet]

Bạn tham khảo đoạn code này xem sao:

Sub ReadFromTextFile()
Dim fs As Scripting.FileSystemObject, f As Scripting.TextStream
Dim l          As Long
    Set fs = New FileSystemObject
    Set f = fs.OpenTextFile("C:\FolderName\TextFileName.txt", _
                            ForReading, False)
    With f
        l = 0
        While Not .AtEndOfStream
            l = l + 1
            Cells(l, 5).Formula = .ReadLine
        Wend
        .Close
    End With
    Set f = Nothing
    Set fs = Nothing
End Sub

Lê Văn Duyệt

 

[Thien]

Hi!

Cách của Giaosy hay lắm rùi có thể sử dụng chứng năng refresh data để cập nhật dử liệu từ file Txt.

Tiện đây xin hỏi có code nào chuyển toàn bộ dữ liệu trong sheet hiện hành sang file txt theo đường dẫn chứa file excel đang mở?.

Thân.

 

[levanduyet]

Bạn thử cái này xem sao:

Sub WriteToTextFile()
Dim fs As Scripting.FileSystemObject, f As Scripting.TextStream
Dim l          As Long
    Set fs = New FileSystemObject
    Set f = fs.OpenTextFile("C:\FolderName\TextFileName.txt", _
                            ForWriting, True)
    With f
        'Thay đoạn code này để xuất dữ liệu từ worksheet
        For l = 1 To 100
            .WriteLine "This is line number " & l
        Next l
        .Close
    End With
    Set f = Nothing
    Set fs = Nothing
End Sub

Sub AppendToTextFile()
Dim fs As Scripting.FileSystemObject, f As Scripting.TextStream
Dim l          As Long
    Set fs = New FileSystemObject
    Set f = fs.OpenTextFile("C:\FolderName\TextFileName.txt", _
                            ForAppending, True)
    With f
        'Thay đoạn code này để xuất dữ liệu từ worksheet
        For l = 1 To 100
            .WriteLine "Added line number " & l
        Next l
        .Close
    End With
    Set f = Nothing
    Set fs = Nothing
End Sub

LVD

 

[giaosy]

Rất cảm ơn bác Duyệt đã giúp em.
Em thử đoạn code của bác rồi nhưng nó báo lỗi: User -defined type not defined

 

[vbavn]

Rất cảm ơn bác Duyệt đã giúp em.
Em thử đoạn code của bác rồi nhưng nó báo lỗi: User -defined type not defined

Bạn phải vào VBE và add ref vào.

VBAVN

 

[PhanTuHuong]

Bạn chịu khó đọc tiếng Anh nhé:

Reading Text Files

You can read text files with the Input statement or the Line Input statement. Input expects data like
that produced by Write and reads the data into a list of variables. Line Input reads the whole line of
data as a single string into a single variable. The following code reads the JanSales.txt file and inserts
the data into a worksheet:

Sub ReadFile()
Dim dDate As Date
Dim sCustomer As String
Dim sProduct As String
Dim dPrice As Double
Dim sFName As String ‘Path and name of text file
Dim iFNumber As Integer ‘File number
Dim lRow As Long ‘Row number in worksheet
sFName = “C:\VBA_Prog_Ref\Chapter12\JanSales.txt”
‘Get an unused file number
iFNumber = FreeFile
‘Prepare file for reading
Open sFName For Input As #iFNumber
Sheet2.Cells.Clear
lRow = 2
Do
‘Read data from file
Input #iFNumber, dDate, sCustomer, sProduct, dPrice
‘Write data to worksheet
With Sheet2
.Cells(lRow, 1) = dDate
.Cells(lRow, 2) = sCustomer
.Cells(lRow, 3) = sProduct
.Cells(lRow, 4) = dPrice
End With
‘Address next row of worksheet
lRow = lRow + 1
‘Loop until end of file
Loop Until EOF(iFNumber)
‘Close the file
Close #iFNumber
End Sub

The Do...Loop processes each line in the file until the EOF function detects that the end of file has been
reached. The Input statement reads each line of the file into four variables

 

[Thien]

Hi!
Code của Anh Duyệt sao lại báo lỗi ở dòng : "fs As Scripting.FileSystemObject" trong WriteToTextFile.

Thật ra mình cũng sưu tầm được 1 vài đoạn code liên quan đến việc lấy dữ liệu từ Txt hoặc xuất sang txt nhưng vẫn chưa được ưng ý (dữ liệu sau khi chuyển sang txt rùi thì được tiếp nối dữ liệu trước, ở đây mình muốn ghi đè lên dữ liệu cũ luôn).

Public Sub ExportToTextFile(FName As String, _
    Sep As String, SelectionOnly As Boolean, _
    AppendData As Boolean)

Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String


Application.ScreenUpdating = False
On Error GoTo EndMacro:
FNum = FreeFile

If SelectionOnly = True Then
    With Selection
        StartRow = .Cells(1).Row
        StartCol = .Cells(1).Column
        EndRow = .Cells(.Cells.Count).Row
        EndCol = .Cells(.Cells.Count).Column
    End With
Else
    With ActiveSheet.UsedRange
        StartRow = .Cells(1).Row
        StartCol = .Cells(1).Column
        EndRow = .Cells(.Cells.Count).Row
        EndCol = .Cells(.Cells.Count).Column
    End With
End If

If AppendData = True Then
    Open FName For Append Access Write As #FNum
Else
    Open FName For Output Access Write As #FNum
End If

For RowNdx = StartRow To EndRow
    WholeLine = ""
    For ColNdx = StartCol To EndCol
        If Cells(RowNdx, ColNdx).Value = "" Then
            CellValue = Chr(34) & Chr(34)
        Else
           CellValue = Cells(RowNdx, ColNdx).Text
        End If
        WholeLine = WholeLine & CellValue & Sep
    Next ColNdx
    WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
    Print #FNum, WholeLine
Next RowNdx

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #FNum

End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' END ExportTextFile
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Because the ExportToTextFile procedure accepts input parameters, you must call it from other VBA code, such as the following:

Sub DoTheExport()
    ExportToTextFile FName:="C:\Test.txt", Sep:=";", _
       SelectionOnly:=False, AppendData:=True
End Sub

In the example DoTheExport procedure above, the file name and the separator character are hard coded in to the code. If you want to prompt the user for the file name and the separator character, use code like the following:
Sub DoTheExport()
    Dim FileName As Variant
    Dim Sep As String
    FileName = Application.GetSaveAsFilename(InitialFileName:=vbNullString, FileFilter:="Text Files (*.txt),*.txt")
    If FileName = False Then
        ''''''''''''''''''''''''''
        ' user cancelled, get out
        ''''''''''''''''''''''''''
        Exit Sub
    End If
    Sep = Application.InputBox("Enter a separator character.", Type:=2)
    If Sep = vbNullString Then
        ''''''''''''''''''''''''''
        ' user cancelled, get out
        ''''''''''''''''''''''''''
        Exit Sub
    End If
    Debug.Print "FileName: " & FileName, "Separator: " & Sep
    ExportToTextFile FName:=CStr(FileName), Sep:=CStr(Sep), _
       SelectionOnly:=False, AppendData:=True
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' END DoTheExport

Thân.

 

[quanthien84]

Hi!

Cách của Giaosy hay lắm rùi có thể sử dụng chứng năng refresh data để cập nhật dử liệu từ file Txt.

Tiện đây xin hỏi có code nào chuyển toàn bộ dữ liệu trong sheet hiện hành sang file txt theo đường dẫn chứa file excel đang mở?.

Thân.

tại sao phải định dạng .txt? sao ko ghi dạng .xml hay sql/access?

 

[levanduyet]

Hi!
Code của Anh Duyệt sao lại báo lỗi ở dòng : "fs As Scripting.FileSystemObject" trong WriteToTextFile.

Em phải tham chiếu đến Scripting.FileSystemObject chứ.
Để thao tác với *.txt có nhiều cách, nhưng nếu dùng cách này thì chúng ta mới giải quyết được font unicode.

Lê Văn Duyệt

 

[adult]

Em phải tham chiếu đến Scripting.FileSystemObject chứ.
Để thao tác với *.txt có nhiều cách, nhưng nếu dùng cách này thì chúng ta mới giải quyết được font unicode.

Lê Văn Duyệt

Bác levanduyet ơi, bác có thể giúp em tạo ra 1 file vd hoàn chỉnh được không ạh để mở mang tầm nhìn được khôn ạh? . Em không khá về VBA lắm.Và cho em hỏi luôn, tham chiếu đến scrripting.filesystemObect như thế nào ạh
Thanks, xin chân thành cám ơn

 

[levanduyet]

To: adult,

Bạn thêm reference như hình sau:

Lê Văn Duyệt