L
Chào các bạn,
Có đôi lúc các bạn muốn xuất dữ liệu ra file text nhằm lưu trữ hay phân phát...(Có rất nhiều lý do) thì phải làm sao?
Tôi xin giới thiệu các bạn một đọan mã đơn giản sau, nhưng các bạn chú ý rằng các bạn phải tham chiếu đến Microsoft ActiveX Data Objects x.x Library trong Reference của mình.
Giả sử trên file excel tôi dự định xuất ra có khối dữ liệu tên MaVatTu gồm:
Cột Mã, Mô tả, Đvt, Tồn ĐK, Nhập từ Nhà Cung cấp, Nhập từ Sản xuất, Xuất đi gia công, Xuất vào sản xuất, Tồn hiện tại.
Mục đích của tôi là xuất ra file "VatTuTon.txt" của cùng thư mục File excel của tôi. Và chỉ xuất ra các vật tư có số lượng tồn lớn hơn 0. Tôi có đọan mã như sau:
Sub XuatTonHienTaiRaFileText()
Dim theFileName As String
Dim FileNum
Dim bRange As Range
Dim Hang As Long, Cot As Integer, i As Long
Dim MaVatTu As String * 15, MoTa As String * 50, DVT As String * 5
Dim TonHienTai As Double
Dim bStrTonHienTai As String * 15
Dim bStrDuaVao As String
theFileName = GetLocalDirectory & "VatTuTon.txt"
FileNum = FreeFile
Set bRange = Range("MaVatTu")
Hang = bRange.Rows.Count: Cot = bRange.Columns.Count
' Mo file de dua vao
Open theFileName For Output As FileNum
'Toi dua ten cac cot vao truoc
'Voi chu y dinh dang chieu dai cua cac truong du lieu
Print [HASHTAG]#FileNum[/HASHTAG], "Ma vat tu |Mo ta |Dvt | "
For i = 1 To Hang
'Quet qua va xuat ra file
With bRange
MaVatTu = Trim(.Cells(i, 1))
MoTa = Trim(.Cells(i, 2))
DVT = Trim(.Cells(i, 3))
TonHienTai = CDbl(.Cells(i, 9))
bStrTonHienTai = CStr(TonHienTai)
bStrDuaVao = MaVatTu & "|" & MoTa & "|" & DVT & "|" & bStrTonHienTai
If MaVatTu <> "" And TonHienTai <> 0 Then
Print [HASHTAG]#FileNum[/HASHTAG], bStrDuaVao
End If
End With
Next i
Close FileNum ' Dong file lai
Set bRange = Nothing
End Sub
Function GetLocalDirectory() As String
Dim TStr
TStr = ActiveWorkbook.Path
If Right(TStr, 1) <> "\" Then TStr = TStr & "\"
GetLocalDirectory = TStr
End Function
Sau đó từ một file excel khác tôi lại viết thủ tục để tôi nhập các dữ liệu trên vào. Kỹ thuật cũng giống trên dùng ADO.
Với chú ý là file excel tôi dự định import dữ liệu vào có sheet tên "Data", và hàng dữ liệu tôi định bắt đầu đưa ra là "A2" của sheet này.
Sub GetTextFileData(ByVal strSQL As String, ByVal strFolder As String, ByVal rngTargetCell As Range)
' example: GetTextFileData "SELECT * FROM filename.txt", _
"C:\FolderName", Range("A3")
' example: GetTextFileData "SELECT * FROM filename.txt WHERE fieldname = 'criteria'", _
"C:\FolderName", Range("A3")
Dim cn As ADODB.Connection, rs As ADODB.Recordset, f As Long
Dim bDem As Long
If rngTargetCell Is Nothing Then Exit Sub
Set cn = New ADODB.Connection
On Error Resume Next
cn.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
"Dbq=" & strFolder & ";" & _
"Extensions=asc,csv,tab,txt;"
On Error GoTo 0
If cn.State <> adStateOpen Then Exit Sub
Set rs = New ADODB.Recordset
On Error Resume Next
rs.Open strSQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
On Error GoTo 0
If rs.State <> adStateOpen Then
cn.Close
Set cn = Nothing
Exit Sub
End If
'Bat dau xuat ra file
With rngTargetCell
bDem = 0
rs.MoveFirst
While Not rs.EOF
.Offset(bDem, 0).Value = Mid(rs.Fields(0).Value, 1, 15)
.Offset(bDem, 1).Value = Mid(rs.Fields(0).Value, 17, 50)
.Offset(bDem, 2).Value = Mid(rs.Fields(0).Value, 68, 5)
.Offset(bDem, 3).Value = Mid(rs.Fields(0).Value, 74, 15)
bDem = bDem + 1
rs.MoveNext
Wend
End With
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Function GetLocalDirectory() As String
' Lay duong dan cua Active workbook
' Va bao dam rang co "\" cuoi duong dan
Dim TStr
TStr = ActiveWorkbook.Path
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Right(TStr, 1) <> "\" Then TStr = TStr & "\"
GetLocalDirectory = TStr
End Function
Function GetLocalDirectoryWT() As String
' Lay duong dan cua Active workbook
' Va bao dam rang khong co "\" cuoi duong dan
Dim TStr
TStr = ActiveWorkbook.Path
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Right(TStr, 1) = "\" Then TStr = Mid(TStr, 1, Len(TStr) - 1)
GetLocalDirectoryWT = TStr
End Function
Sub NhapDuLieu()
Dim bRange As Range
Dim TenThuMuc
'Xoa du lieu truoc khi dua du lieu vao
Set bRange = Range("DuLieuXoa")
bRange.Clear
TenThuMuc = GetLocalDirectoryWT
Call GetTextFileData("SELECT * FROM VatTuTon.txt", TenThuMuc, Range("A2"))
End Sub
Tại sheet "Data" tôi định dạng hàng đầu tiên như sau:
A1: Mã vật tư; B1: Mô tả; C1: Đvt; D1: Số lượng tồn hiện tại
và tôi tạo một nút lệnh gọi thủ tục NhapDuLieu như trên.
Thế là tôi đã giới thiệu sơ lược dùng ADO để xuất và lấy dữ liệu.
Tham khảo từ trang web Erlandsen Data Consulting, Vovisoft
Lương Văn Luyện
Có đôi lúc các bạn muốn xuất dữ liệu ra file text nhằm lưu trữ hay phân phát...(Có rất nhiều lý do) thì phải làm sao?
Tôi xin giới thiệu các bạn một đọan mã đơn giản sau, nhưng các bạn chú ý rằng các bạn phải tham chiếu đến Microsoft ActiveX Data Objects x.x Library trong Reference của mình.
Giả sử trên file excel tôi dự định xuất ra có khối dữ liệu tên MaVatTu gồm:
Cột Mã, Mô tả, Đvt, Tồn ĐK, Nhập từ Nhà Cung cấp, Nhập từ Sản xuất, Xuất đi gia công, Xuất vào sản xuất, Tồn hiện tại.
Mục đích của tôi là xuất ra file "VatTuTon.txt" của cùng thư mục File excel của tôi. Và chỉ xuất ra các vật tư có số lượng tồn lớn hơn 0. Tôi có đọan mã như sau:
Sub XuatTonHienTaiRaFileText()
Dim theFileName As String
Dim FileNum
Dim bRange As Range
Dim Hang As Long, Cot As Integer, i As Long
Dim MaVatTu As String * 15, MoTa As String * 50, DVT As String * 5
Dim TonHienTai As Double
Dim bStrTonHienTai As String * 15
Dim bStrDuaVao As String
theFileName = GetLocalDirectory & "VatTuTon.txt"
FileNum = FreeFile
Set bRange = Range("MaVatTu")
Hang = bRange.Rows.Count: Cot = bRange.Columns.Count
' Mo file de dua vao
Open theFileName For Output As FileNum
'Toi dua ten cac cot vao truoc
'Voi chu y dinh dang chieu dai cua cac truong du lieu
Print [HASHTAG]#FileNum[/HASHTAG], "Ma vat tu |Mo ta |Dvt | "
For i = 1 To Hang
'Quet qua va xuat ra file
With bRange
MaVatTu = Trim(.Cells(i, 1))
MoTa = Trim(.Cells(i, 2))
DVT = Trim(.Cells(i, 3))
TonHienTai = CDbl(.Cells(i, 9))
bStrTonHienTai = CStr(TonHienTai)
bStrDuaVao = MaVatTu & "|" & MoTa & "|" & DVT & "|" & bStrTonHienTai
If MaVatTu <> "" And TonHienTai <> 0 Then
Print [HASHTAG]#FileNum[/HASHTAG], bStrDuaVao
End If
End With
Next i
Close FileNum ' Dong file lai
Set bRange = Nothing
End Sub
Function GetLocalDirectory() As String
Dim TStr
TStr = ActiveWorkbook.Path
If Right(TStr, 1) <> "\" Then TStr = TStr & "\"
GetLocalDirectory = TStr
End Function
Sau đó từ một file excel khác tôi lại viết thủ tục để tôi nhập các dữ liệu trên vào. Kỹ thuật cũng giống trên dùng ADO.
Với chú ý là file excel tôi dự định import dữ liệu vào có sheet tên "Data", và hàng dữ liệu tôi định bắt đầu đưa ra là "A2" của sheet này.
Sub GetTextFileData(ByVal strSQL As String, ByVal strFolder As String, ByVal rngTargetCell As Range)
' example: GetTextFileData "SELECT * FROM filename.txt", _
"C:\FolderName", Range("A3")
' example: GetTextFileData "SELECT * FROM filename.txt WHERE fieldname = 'criteria'", _
"C:\FolderName", Range("A3")
Dim cn As ADODB.Connection, rs As ADODB.Recordset, f As Long
Dim bDem As Long
If rngTargetCell Is Nothing Then Exit Sub
Set cn = New ADODB.Connection
On Error Resume Next
cn.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
"Dbq=" & strFolder & ";" & _
"Extensions=asc,csv,tab,txt;"
On Error GoTo 0
If cn.State <> adStateOpen Then Exit Sub
Set rs = New ADODB.Recordset
On Error Resume Next
rs.Open strSQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
On Error GoTo 0
If rs.State <> adStateOpen Then
cn.Close
Set cn = Nothing
Exit Sub
End If
'Bat dau xuat ra file
With rngTargetCell
bDem = 0
rs.MoveFirst
While Not rs.EOF
.Offset(bDem, 0).Value = Mid(rs.Fields(0).Value, 1, 15)
.Offset(bDem, 1).Value = Mid(rs.Fields(0).Value, 17, 50)
.Offset(bDem, 2).Value = Mid(rs.Fields(0).Value, 68, 5)
.Offset(bDem, 3).Value = Mid(rs.Fields(0).Value, 74, 15)
bDem = bDem + 1
rs.MoveNext
Wend
End With
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Function GetLocalDirectory() As String
' Lay duong dan cua Active workbook
' Va bao dam rang co "\" cuoi duong dan
Dim TStr
TStr = ActiveWorkbook.Path
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Right(TStr, 1) <> "\" Then TStr = TStr & "\"
GetLocalDirectory = TStr
End Function
Function GetLocalDirectoryWT() As String
' Lay duong dan cua Active workbook
' Va bao dam rang khong co "\" cuoi duong dan
Dim TStr
TStr = ActiveWorkbook.Path
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Right(TStr, 1) = "\" Then TStr = Mid(TStr, 1, Len(TStr) - 1)
GetLocalDirectoryWT = TStr
End Function
Sub NhapDuLieu()
Dim bRange As Range
Dim TenThuMuc
'Xoa du lieu truoc khi dua du lieu vao
Set bRange = Range("DuLieuXoa")
bRange.Clear
TenThuMuc = GetLocalDirectoryWT
Call GetTextFileData("SELECT * FROM VatTuTon.txt", TenThuMuc, Range("A2"))
End Sub
Tại sheet "Data" tôi định dạng hàng đầu tiên như sau:
A1: Mã vật tư; B1: Mô tả; C1: Đvt; D1: Số lượng tồn hiện tại
và tôi tạo một nút lệnh gọi thủ tục NhapDuLieu như trên.
Thế là tôi đã giới thiệu sơ lược dùng ADO để xuất và lấy dữ liệu.
Tham khảo từ trang web Erlandsen Data Consulting, Vovisoft
Lương Văn Luyện
Sửa lần cuối:
