Vài thủ thuật xử lý text file

Các thủ thuật về hệ thống, thư mục, tập tin và mạng
Đăng trả lời
Hình đại diện của thành viên
truongphu
VIP
VIP
Bài viết: 4783
Ngày tham gia: Chủ nhật 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 526 times

Vài thủ thuật xử lý text file

Gửi bài by truongphu »

Thủ thuật: Vài thủ thuật xử lý text file
Tác giả: truongphu
Mô tả: Vài thủ thuật xử lý text file
Tôi đang đọc "Nạp Thiếp ký" và một số truyện khác...; đọc mỗi chương (ngắn ngủn) phải nhấn nút ủng hộ điểm (OK điều nầy). Nhưng lỡ cúp điện hay muốn đọc lại thì cứ nhấn nút... (tốn tiền)
Do vậy tôi phải Save as dưới dạng txt sau khi nhấn toàn bộ nút trên một trang. (nhiều trang lắm!)
44.JPG
kết quả text file trình bày ở giữa, 2 bên là space kèm vbCrLf.
(Lưu ý: file tiếng việt nhưng là UTF-8, nên đổi lần nữa ra unicode hầu thích hợp với code sau)
Để sửa lại, buộc phải dùng đến phần mềm chứ dùng tay edit từng dòng thì thua. Bài viết nầy có mục đích đó với các thủ thuật:

- CommonDialog với code thuần túy
- Chọn file để lọc (doc hay txt)
- Ứng dụng VBA/Word để mở file Word, tải vào TextBox có hổ trợ tiếng Việt hoàn toàn
- Ứng dụng FileSystemObject để mở file txt unicode, tải vào TextBox có hổ trợ tiếng Việt hoàn toàn
- Loại space và vbCrLf thừa
- Lưu lại dưới dạng doc hay TXT unicode

và chia sẻ đến các bạn project nầy.

Lưu ý: đây chỉ là project tham khảo, các bạn có thể edit lại theo ý riêng

và nếu chạy không được, hay lỗi thì thôi nha...


  1. Dim TênFile As String
  2.  
  3. Private Sub Command1_Click()
  4. Set objDialog = CreateObject("UserAccounts.CommonDialog")
  5. objDialog.Filter = "Word Document|*.Doc|Text File|*.txt"
  6. objDialog.InitialDir = "D"
  7. If Command2.BackColor = &HC0FFFF Then
  8.     objDialog.filterIndex = 1
  9. Else
  10.     objDialog.filterIndex = 2
  11. End If
  12. intResult = objDialog.ShowOpen
  13. If intResult <> 0 Then
  14.     TênFile = objDialog.FileName
  15.     Select Case UCase(Right(TênFile, 3))
  16.         Case "DOC"
  17.             Set objWord = CreateObject("Word.Application")
  18.             Set objDoc = objWord.Documents.Open(TênFile)
  19.             objWord.Visible = False
  20.             TextBox1 = objDoc.Range
  21.             objWord.Quit
  22.         Case "TXT"
  23.             TextBox1 = ReadFileUni(TênFile)
  24.         Case Else
  25.     End Select
  26. End If
  27. End Sub
  28.  
  29. Private Sub Command2_Click()
  30. If Command2.BackColor = &HC0FFFF Then
  31.     Command2.BackColor = &HFFFFC0
  32.     Command2.Caption = "File Txt"
  33.     Command1.Caption = "Open File TXT"
  34. Else
  35.     Command2.BackColor = &HC0FFFF
  36.     Command2.Caption = "File Doc"
  37.     Command1.Caption = "Open File DOC"
  38. End If
  39. End Sub
  40.  
  41. Private Sub Command3_Click()
  42. Dim Str$ Str = TextBox1.Text
  43. Do While InStr(Str, "  ") > 0
  44.     Str = Replace(Str, "  ", " ")
  45. Loop
  46. Do While InStr(Str, vbCrLf & vbCrLf) > 0
  47.     Str = Replace(Str, vbCrLf & vbCrLf, vbCrLf)
  48. Loop
  49. Do While InStr(Str, vbCrLf & " ") > 0
  50.     Str = Replace(Str, vbCrLf & " ", vbCrLf)
  51. Loop
  52. TextBox1 = Str
  53. MsgBox "Ðã Xong"
  54. End Sub
  55.  
  56. Private Sub Command4_Click()
  57. If Command2.BackColor = &HC0FFFF Then
  58.     Set objWord = CreateObject("Word.Application")
  59.     Set DocApp = objWord.Documents.Add
  60.     objWord.Selection.Range = TextBox1.Text
  61.     DocApp.SaveAs App.Path & "\New " & FileNameFromPath(TênFile)
  62.     Set objWord = Nothing
  63. Else
  64.     WriteFileUni App.Path & "\New " & FileNameFromPath(TênFile), TextBox1.Text
  65. End If
  66. MsgBox "Ðã Xong"
  67. End Sub
  68.  
  69. Private Function ReadFileUni(FileName As String) As String
  70.    Set FSO = CreateObject("Scripting.FileSystemObject").OpenTextFile(FileName, 1, , -2)
  71.    ReadFileUni = FSO.Readall
  72.    Set FSO = Nothing
  73. End Function
  74.  
  75. Private Function WriteFileUni(FileName As String, Unistr As String)
  76.       Set FSO = CreateObject("Scripting.FileSystemObject").CreateTextFile(FileName, True)
  77.       Set FSO = Nothing
  78.       Set FSO = CreateObject("Scripting.FileSystemObject").OpenTextFile(FileName, 2, , -1)
  79.           FSO.Write Unistr
  80.       Set FSO = Nothing
  81. End Function
  82.  
  83. Public Function FileNameFromPath(ByVal sPath As String) As String
  84.     FileNameFromPath = Mid(sPath, InStrRev(sPath, "") + 1)
  85. End Function
Tập tin đính kèm
Xóa Space.rar
(2.2 KiB) Đã tải về 601 lần
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh
Đăng trả lời

Quay về