Bài 12. FileSystemObject [Danh sách các bài viết về VBA xem ở đây Index - Các bài viết về VBA] FileSystemObject [FSo] là một phần trong thư viện Microsoft Scripting Runtime [scrrun.dll], là công cụ xử lý về Drive, Folder, File. Nội dung chính gồm:
1 1. Khai báo 2. Các phương thức 2.1...
giaiphapexcel.com
1+1=2
Thành viên bị đình chỉ hoạt động-
3
Tìm đọc bài của bạn @befaint
Bài 12. FileSystemObject [Danh sách các bài viết về VBA xem ở đây Index - Các bài viết về VBA] FileSystemObject [FSo] là một phần trong thư viện Microsoft Scripting Runtime [scrrun.dll], là công cụ xử lý về Drive, Folder, File. Nội dung chính gồm:
1 1. Khai báo 2. Các phương thức 2.1...
giaiphapexcel.comcháu đang đọc. Mà Thật sự nó quá dài. Cháu chưa tìm được đoạn code đó. chưa thấy chổ nào có chổ Liên quan đến Ctrl A tất cả trong Notepad và dán vào excel . Mong bác giúp đở.
Đại khái đoạn code cháu mong muốn như thế này 1. Mở file notpad [ Tức nhiên đường dẫn cháu tự sữa ] 2. Ctrl + A và tiếp tục Ctrl + C để copy tất cả dử liệu trong Notepad 3. Đặt con trỏ vào 1 ô nào đó trên bảng tình và Ctrl + V để Dán dữ liệu vào Excel 4. Đóng file notepad
-
4
cháu đang đọc. Mà Thật sự nó quá dài. Cháu chưa tìm được đoạn code đó. chưa thấy chổ nào có chổ Liên quan đến Ctrl A tất cả trong Notepad và dán vào excel . Mong bác giúp đở.
Không cần mở file text và Ctrl+A, chỉ cần đường dẫn
Mã:
'// Tra ve chuoi la noi dung cua text file theo duong dan chi dinh'
Public Function ReadTextFile[ByVal pathTextFile As String] As String
Dim FSo As Object, txtFile As Object, sText As String
Set FSo = CreateObject["Scripting.FileSystemObject"]
Set txtFile = FSo.OpenTextFile[pathTextFile, 1, False, -2]
sText = txtFile.ReadAll
txtFile.Close
ReadTextFile = sText
End Function
1+1=2
Thành viên bị đình chỉ hoạt động-
5
Không cần mở file text và Ctrl+A, chỉ cần đường dẫn
Mã:
'// Tra ve chuoi la noi dung cua text file theo duong dan chi dinh'
Public Function ReadTextFile[ByVal pathTextFile As String] As String
Dim FSo As Object, txtFile As Object, sText As String
Set FSo = CreateObject["Scripting.FileSystemObject"]
Set txtFile = FSo.OpenTextFile[pathTextFile, 1, False, -2]
sText = txtFile.ReadAll
txtFile.Close
ReadTextFile = sText
End Function
Cháu cảm ơn bác. Nhưng cái đó là Hàm. Mong bác viết ra Sub giúp cháu. tại cháu đang học VBA khóa cơ bản nưa chưa rành các thủ tục viết code. 1 Lần nữa rất mong chú giúp đỡ
-
6
Cháu cảm ơn bác. Nhưng cái đó là Hàm. Mong bác viết ra Sub giúp cháu. tại cháu đang học VBA khóa cơ bản nưa chưa rành các thủ tục viết code. 1 Lần nữa rất mong chú giúp đỡ
Bạn tham khảo thêm code trên GPE không nhớ của thành viên quản trị nào
Mã:
Đây là 1 code dùng để import dữ liệu từ 1 hay nhiều file txt vào file excel.
Với code này bạn chỉ cần kiểm tra xem file txt sử dụng dấu phân cách gì và sửa lại chỗ Delimiter= vbTab
Nếu dấu phân cách là dấu phẩy [,] thì sửa lại thế này Delimiter= ","
Lưu ý là code này khai báo chỉ số lớn nhất của mảng chỉ có 65536, nếu dữ liệu có nhiều hơn thì sẽ gây ra lỗi. Trong trường hợp đó bạn có thể sửa số 65536 thành 1 số lớn hơn. [Chắc hiếm gặp]
Code này sẽ xử lý tất cả file text xong rồi mới gán dữ liệu 1 lần xuống sheet tại ô A2. Bạn có thể sửa lại cho phù hợp.
PHP Code:
Sub ImportTextToExcel[]
Dim fso As Object, FilesToOpen, TextSource As Object, TotalLines, Res[]
Dim ItemsOfLine, TextItem, Delimiter As String, n As Byte
Dim K As Long, X As Byte, Cols As Integer, LineNum As Long
Set fso = CreateObject["Scripting.FileSystemObject"]
Delimiter = vbTab
FilesToOpen = Application.GetOpenFilename["Text Files [*.txt], *.txt", , , , True]
If Not IsArray[FilesToOpen] Then Exit Sub
For X = LBound[FilesToOpen] To UBound[FilesToOpen]
Set TextSource = fso.OpenTextFile[FilesToOpen[X], 1, , -2]
TotalLines = Split[TextSource.ReadAll, vbCrLf]
For LineNum = LBound[TotalLines] To UBound[TotalLines]
ItemsOfLine = TotalLines[LineNum]
TextItem = Split[ItemsOfLine, Delimiter]
If UBound[TextItem] + 1 > n Then
ReDim Preserve Res[1 To 65536, 1 To UBound[TextItem] + 1]
n = UBound[TextItem] + 1
End If
If ItemsOfLine String[Len[ItemsOfLine], vbTab] Then
K = K + 1
For Cols = LBound[TextItem] To UBound[TextItem]
Res[K, Cols + 1] = TextItem[Cols]
Next
End If
Next
Next
[A2].Resize[K, UBound[Res, 2]] = Res
End Sub
1+1=2
Thành viên bị đình chỉ hoạt động-
7
Bạn tham khảo thêm code trên GPE không nhớ của thành viên quản trị nào
Mã:
Đây là 1 code dùng để import dữ liệu từ 1 hay nhiều file txt vào file excel.
Với code này bạn chỉ cần kiểm tra xem file txt sử dụng dấu phân cách gì và sửa lại chỗ Delimiter= vbTab
Nếu dấu phân cách là dấu phẩy [,] thì sửa lại thế này Delimiter= ","
Lưu ý là code này khai báo chỉ số lớn nhất của mảng chỉ có 65536, nếu dữ liệu có nhiều hơn thì sẽ gây ra lỗi. Trong trường hợp đó bạn có thể sửa số 65536 thành 1 số lớn hơn. [Chắc hiếm gặp]
Code này sẽ xử lý tất cả file text xong rồi mới gán dữ liệu 1 lần xuống sheet tại ô A2. Bạn có thể sửa lại cho phù hợp.
PHP Code:
Sub ImportTextToExcel[]
Dim fso As Object, FilesToOpen, TextSource As Object, TotalLines, Res[]
Dim ItemsOfLine, TextItem, Delimiter As String, n As Byte
Dim K As Long, X As Byte, Cols As Integer, LineNum As Long
Set fso = CreateObject["Scripting.FileSystemObject"]
Delimiter = vbTab
FilesToOpen = Application.GetOpenFilename["Text Files [.txt], .txt", , , , True]If Not IsArray[FilesToOpen] Then Exit Sub
For X = LBound[FilesToOpen] To UBound[FilesToOpen]
Set TextSource = fso.OpenTextFile[FilesToOpen[X], 1, , -2]
TotalLines = Split[TextSource.ReadAll, vbCrLf]
For LineNum = LBound[TotalLines] To UBound[TotalLines]
ItemsOfLine = TotalLines[LineNum]
TextItem = Split[ItemsOfLine, Delimiter]
If UBound[TextItem] + 1 > n Then
ReDim Preserve Res[1 To 65536, 1 To UBound[TextItem] + 1]
n = UBound[TextItem] + 1
End If
If ItemsOfLine String[Len[ItemsOfLine], vbTab] Then
K = K + 1
For Cols = LBound[TextItem] To UBound[TextItem]
Res[K, Cols + 1] = TextItem[Cols]
Next
End If
Next
Next
[A2].Resize[K, UBound[Res, 2]] = Res
End Sub
Code chạy ok rồi cảm ơn CHú nhiều. Trường hợp cháu chỉ lấy mỗi 1 file notepad tại đưởng dẩn đã cài đặt sẳng Sheets["data"].Range["M2"] thì sữa lại đoạn này FilesToOpen = Application.GetOpenFilename["Text Files [*.txt], *.txt", , , , True]
Như thế nào để nó hiểu nó lấy từ Sheets["data"].Range["M2"]
Cu Tồ
Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂-
8
Bạn tham khảo thêm code trên GPE không nhớ của thành viên quản trị nào
Mã:
Đây là 1 code dùng để import dữ liệu từ 1 hay nhiều file txt vào file excel.
Với code này bạn chỉ cần kiểm tra xem file txt sử dụng dấu phân cách gì và sửa lại chỗ Delimiter= vbTab
Nếu dấu phân cách là dấu phẩy [,] thì sửa lại thế này Delimiter= ","
Lưu ý là code này khai báo chỉ số lớn nhất của mảng chỉ có 65536, nếu dữ liệu có nhiều hơn thì sẽ gây ra lỗi. Trong trường hợp đó bạn có thể sửa số 65536 thành 1 số lớn hơn. [Chắc hiếm gặp]
Code này sẽ xử lý tất cả file text xong rồi mới gán dữ liệu 1 lần xuống sheet tại ô A2. Bạn có thể sửa lại cho phù hợp.
PHP Code:
Sub ImportTextToExcel[]
Dim fso As Object, FilesToOpen, TextSource As Object, TotalLines, Res[]
Dim ItemsOfLine, TextItem, Delimiter As String, n As Byte
Dim K As Long, X As Byte, Cols As Integer, LineNum As Long
Set fso = CreateObject["Scripting.FileSystemObject"]
Delimiter = vbTab
FilesToOpen = Application.GetOpenFilename["Text Files [.txt], .txt", , , , True]If Not IsArray[FilesToOpen] Then Exit Sub
For X = LBound[FilesToOpen] To UBound[FilesToOpen]
Set TextSource = fso.OpenTextFile[FilesToOpen[X], 1, , -2]
TotalLines = Split[TextSource.ReadAll, vbCrLf]
For LineNum = LBound[TotalLines] To UBound[TotalLines]
ItemsOfLine = TotalLines[LineNum]
TextItem = Split[ItemsOfLine, Delimiter]
If UBound[TextItem] + 1 > n Then
ReDim Preserve Res[1 To 65536, 1 To UBound[TextItem] + 1]
n = UBound[TextItem] + 1
End If
If ItemsOfLine String[Len[ItemsOfLine], vbTab] Then
K = K + 1
For Cols = LBound[TextItem] To UBound[TextItem]
Res[K, Cols + 1] = TextItem[Cols]
Next
End If
Next
Next
[A2].Resize[K, UBound[Res, 2]] = Res
End Sub
Bác cho hỏi code lỗi phần thông dịch thì sửa lại như thế nào à? khi file txt có tiếng nhật hàn hoặc tiếng trung thì dữ liệu đưa vào bảng tính bị thay đổi ạ
-
9
Code chạy ok rồi cảm ơn CHú nhiều. Trường hợp cháu chỉ lấy mỗi 1 file notepad tại đưởng dẩn đã cài đặt sẳng Sheets["data"].Range["M2"] thì sữa lại đoạn này FilesToOpen = Application.GetOpenFilename["Text Files [*.txt], *.txt", , , , True]
Lấy lệnh 2 code ghép lại
Mã:
Sub ImportTextToExcel[]
Dim fso As Object, FilesToOpen, TextSource As Object, TotalLines, Res[]
Dim ItemsOfLine, TextItem, Delimiter As String, n As Byte
Dim K As Long, X As Byte, Cols As Integer, LineNum As Long
Set fso = CreateObject["Scripting.FileSystemObject"]
Delimiter = vbTab
pathTextFile=Sheets["data"].Range["M2"].value
Set TextSource = fso.OpenTextFile[pathTextFile, 1, , -2]
TotalLines = Split[TextSource.ReadAll, vbCrLf]
For LineNum = LBound[TotalLines] To UBound[TotalLines]
ItemsOfLine = TotalLines[LineNum]
TextItem = Split[ItemsOfLine, Delimiter]
If UBound[TextItem] + 1 > n Then
ReDim Preserve Res[1 To 65536, 1 To UBound[TextItem] + 1]
n = UBound[TextItem] + 1
End If
If ItemsOfLine String[Len[ItemsOfLine], vbTab] Then
K = K + 1
For Cols = LBound[TextItem] To UBound[TextItem]
Res[K, Cols + 1] = TextItem[Cols]
Next
End If
Next
[A2].Resize[K, UBound[Res, 2]] = Res
End Sub
Bài đã được tự động gộp: 13/7/20
Bác cho hỏi code lỗi phần thông dịch thì sửa lại như thế nào à? khi file txt có tiếng nhật hàn hoặc tiếng trung thì dữ liệu đưa vào bảng tính bị thay đổi ạ
Có file ví dụ mới biết xử lý như thế nào
1+1=2
Thành viên bị đình chỉ hoạt động-
10
Lấy lệnh 2 code ghép lại
Mã:
Sub ImportTextToExcel[]
Dim fso As Object, FilesToOpen, TextSource As Object, TotalLines, Res[]
Dim ItemsOfLine, TextItem, Delimiter As String, n As Byte
Dim K As Long, X As Byte, Cols As Integer, LineNum As Long
Set fso = CreateObject["Scripting.FileSystemObject"]
Delimiter = vbTab
pathTextFile=Sheets["data"].Range["M2"].value
Set TextSource = fso.OpenTextFile[pathTextFile, 1, , -2]
TotalLines = Split[TextSource.ReadAll, vbCrLf]
For LineNum = LBound[TotalLines] To UBound[TotalLines]
ItemsOfLine = TotalLines[LineNum]
TextItem = Split[ItemsOfLine, Delimiter]
If UBound[TextItem] + 1 > n Then
ReDim Preserve Res[1 To 65536, 1 To UBound[TextItem] + 1]
n = UBound[TextItem] + 1
End If
If ItemsOfLine String[Len[ItemsOfLine], vbTab] Then
K = K + 1
For Cols = LBound[TextItem] To UBound[TextItem]
Res[K, Cols + 1] = TextItem[Cols]
Next
End If
Next
[A2].Resize[K, UBound[Res, 2]] = Res
End Sub
Bài đã được tự động gộp: 13/7/20
Có file ví dụ mới biết xử lý như thế nàoChân thành cảm ơn chú nhiều
Cu Tồ
Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂-
11
file đây bác ah,khi e thử với tiếng nước ngoài thì nội dung đưa vào và nội dung notpad không giống nhau ạ
- test.rar 15.6 KB · Đọc: 6
-
12
Chân thành cảm ơn chú nhiều
Bạn nên tham khảo cách dùng FileSystemObject chuyển dữ liệu Excel vào file Text
Cu Tồ
Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂-
14
file đây bác ah,khi e thử với tiếng nước ngoài thì nội dung đưa vào và nội dung notpad không giống nhau ạ
Bạn chọn 2 ô format theo font chữ nước Nhật hoặc Hàn xem sao
Cu Tồ
Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂-
15
file đây bác ah,khi e thử với tiếng nước ngoài thì nội dung đưa vào và nội dung notpad không giống nhau ạ
còn đây là e thử code lúc nãy bác vừa đưa lên cũng bị như thế ạ
Bài đã được tự động gộp: 13/7/20
Bạn chọn 2 ô format theo font chữ nước Nhật hoặc Hàn xem sao
e đã thử nhưng vẫn lỗi như thế bác ạ
Cu Tồ
Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂-
17
Do code viết chưa xét được chữ nước ngoài
có cách khắc phục không bác ơi?
-
18
file đây bác ah,khi e thử với tiếng nước ngoài thì nội dung đưa vào và nội dung notpad không giống nhau ạ
Ngay cả tiếng Việt thì cũng thế thôi, đâu cần đi xa kiểm tra Nhật Hàn. Dễ kiểm tra thôi.
Bạn làm thí nghiệm nhé.
1. Hãy kích hoạt Unikey, chọn Bảng mã là Unicode -> mở notepad -> gõ sung sướng -> ghi lại với encoding = UTF-8 -> chạy code -> chọn tập tin vừa lưu. Sẽ thấy đầu trâu mặt ngựa.
2. Hãy kích hoạt Unikey, chọn Bảng mã là Unicode -> mở notepad -> gõ sung sướng -> ghi lại với encoding = Unicode, vd. trong Windows 10 chọn UTF-16 LE [Unicode Little Endian] -> chạy code -> chọn tập tin vừa lưu. Sẽ thấy sung sướng.
Bạn hiểu rồi chứ?
Tập tin của bạn hiện có encoding = UTF-8. Hãy mở bằng notepad và lưu lại với encoding = UTF-16 LE. Sau đó chạy code và chọn tập tin. Về phông chữ để hiển thị thì bạn có thể chọn phông chữ Times New Roman.
Cu Tồ
Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂-
19
Ngay cả tiếng Việt thì cũng thế thôi, đâu cần đi xa kiểm tra Nhật Hàn. Dễ kiểm tra thôi.
Bạn làm thí nghiệm nhé.
1. Hãy kích hoạt Unikey, chọn Bảng mã là Unicode -> mở notepad -> gõ sung sướng -> ghi lại với encoding = UTF-8 -> chạy code -> chọn tập tin vừa lưu. Sẽ thấy đầu trâu mặt ngựa.
2. Hãy kích hoạt Unikey, chọn Bảng mã là Unicode -> mở notepad -> gõ sung sướng -> ghi lại với encoding = Unicode, vd. trong Windows 10 chọn UTF-16 LE [Unicode Little Endian] -> chạy code -> chọn tập tin vừa lưu. Sẽ thấy sung sướng.
Bạn hiểu rồi chứ?
Tập tin của bạn hiện có encoding = UTF-8. Hãy mở bằng notepad và lưu lại với encoding = UTF-16 LE. Sau đó chạy code và chọn tập tin. Về phông chữ để hiển thị thì bạn có thể chọn phông chữ Times New Roman.cảm ơn bác đã hướng dẫn,e làm theo cách của bác được rồi ạ
1+1=2
Thành viên bị đình chỉ hoạt động-
20
Ngay cả tiếng Việt thì cũng thế thôi, đâu cần đi xa kiểm tra Nhật Hàn. Dễ kiểm tra thôi.
Bạn làm thí nghiệm nhé.
1. Hãy kích hoạt Unikey, chọn Bảng mã là Unicode -> mở notepad -> gõ sung sướng -> ghi lại với encoding = UTF-8 -> chạy code -> chọn tập tin vừa lưu. Sẽ thấy đầu trâu mặt ngựa.
2. Hãy kích hoạt Unikey, chọn Bảng mã là Unicode -> mở notepad -> gõ sung sướng -> ghi lại với encoding = Unicode, vd. trong Windows 10 chọn UTF-16 LE [Unicode Little Endian] -> chạy code -> chọn tập tin vừa lưu. Sẽ thấy sung sướng.
Bạn hiểu rồi chứ?
Tập tin của bạn hiện có encoding = UTF-8. Hãy mở bằng notepad và lưu lại với encoding = UTF-16 LE. Sau đó chạy code và chọn tập tin. Về phông chữ để hiển thị thì bạn có thể chọn phông chữ Times New Roman.Cháu chân thành cảm ơn 2 Bác @batman1 @HieuCD đã hỗ trợ. sau khi cháu kiểm tra lại thì code nó không lấy chính xác trong Notepad ra Excel nó tự xóa bỏ đi các dòng trống. Ý của cháu kiểu như là như thế này cháu xin nói rõ như sau: Cháu đang dùng đoạn code này của Bác @ndu96081631 Code này dùng để copy 1 vùng dữ liệu trên Excel ra Notepad code chạy rất chính xác
Mã:
Sub xuatexcelnotepad[]
'On Error Resume Next
Dim rngData As Range
Dim strData As String
Dim strTempFile As String
' Nguon copy
Set rngData = Range["a1:c16"]
rngData.Copy
' mac dinh
With CreateObject["New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"]
.GetFromClipboard
strData = .GetText
End With
' nguon notepad
strTempFile = Range["E1"].Value
CreateObject["Scripting.FileSystemObject"].CreateTextFile[strTempFile, True, True].Write strData
Application.CutCopyMode = False
End Sub
Nhưng giờ sau cháu muốn lấy ngược lại nghĩa là lấy từ Notepad đổ vào lại trong Excel . Thì cháy dùng code của Bác HieuCD
Mã:
Sub ImportTextToExcel[]
On Error Resume Next
Dim fso As Object, FilesToOpen, TextSource As Object, TotalLines, Res[]
Dim ItemsOfLine, TextItem, Delimiter As String, n As Byte
Dim K As Long, X As Byte, Cols As Integer, LineNum As Long
Set fso = CreateObject["Scripting.FileSystemObject"]
Delimiter = vbTab
pathTextFile = Range["e1"].Value ' Duong dan Lay
Set TextSource = fso.OpenTextFile[pathTextFile, 1, , -2]
TotalLines = Split[TextSource.ReadAll, vbCrLf]
For LineNum = LBound[TotalLines] To UBound[TotalLines]
ItemsOfLine = TotalLines[LineNum]
TextItem = Split[ItemsOfLine, Delimiter]
If UBound[TextItem] + 1 > n Then
ReDim Preserve Res[1 To 65536, 1 To UBound[TextItem] + 1]
n = UBound[TextItem] + 1
End If
If ItemsOfLine String[Len[ItemsOfLine], vbTab] Then
K = K + 1
For Cols = LBound[TextItem] To UBound[TextItem]
Res[K, Cols + 1] = TextItem[Cols]
Next
End If
Next
[f1].Resize[K, UBound[Res, 2]] = Res ' Output
End Sub
Mà không hiểu sao nó lại xóa đi mầy dòng trống. Cháu muốn nó kiểu như làm thủ công là Ctrl +A toàn bộ file Notepad sau đó Ctrl + C, rồi chọn vào Excel rồi Ctrl + V thế là xong. rất mong các chú giúp cháu. cháu xin chân thành cảm ơn các chú