กระทู้เก่าบอร์ด อ.สุภาพ ไชยา
272 1
URL.หัวข้อ /
URL
Help - Export query to file and split into multiple files
ถามไว้ที่ http://www.utteraccess.com/forums/showflat.php?Cat=&Board=AxxessXP&Number=221131
เขาต้องการที่จะนำข้อมูลทั้งหมดใน Query เป้าหมาย เพื่อนำไปสร้างเป็นไฟล์ Text โดยสามารถกำหนดว่าจะให้แต่ละไฟล์มีจำนวนข้อมูลมากน้อยแค่ไหนได้ด้วย ดังนี้
1: กำหนดชื่อไฟล์ txt เองได้
2: เลือกจำนวนข้อมูลที่ต้องการในแต่ละไฟล์ได้
3: เริ่มนับจำนวนข้อมูล
4: เริ่มส่งข้อมูลออกไป txt ไฟล์จนกว่าจะครบตามจำนวนที่จำกัดไว้
5: สร้างไฟล์ใหม่ และเริ่มนับจำนวนข้อมูลใหม่
6: แต่ละไฟล์จะต้องมีชื่อฟีลด์ต่างๆ ติดไปด้วยทุกอัน
7: วนจนหมดข้อมูลเป้าหมาย
ผมให้โค้ดเขาไปดังนี้ครับ
Function CreateMultipleFiles(strFileName As String, Optional intX As Integer)
Dim dbs As Object
Dim rst As Object
Dim strData As String, strFieldName As String
Dim strNewFile As String, I As Integer
Dim Y As Integer, X As Integer
'On Error GoTo Err_FileOpen
' If the record limit is left out.
' Limit only 3000 records per file.
If intX = 0 Then
intX = 3000
End If
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Query1")
' Get the fields' name.
For I = 0 To rst.Fields.Count - 1
strFieldName = strFieldName & rst.Fields(I).Name & ", "
Next I
Y = 0
X = 1
' Create the first text file.
strNewFile = "c:\" & strFileName & X & ".txt"
Open strNewFile For Output As #1
' Write the fields' name on the first line.
Print #1, strFieldName & vbCr
Do While Not rst.EOF
' Get each record separated with comma.
For I = 0 To rst.Fields.Count - 1
strData = strData & rst(I) & ", "
Next I
' Write to the text file.
Print #1, strData & vbCr
strData = ""
Y = Y + 1
If Y / intX = 1 Then
' If it reaches the limit of the line, close the file and open the new file.
Close #1
Y = 0
X = X + 1
' Create the first text file.
strNewFile = "c:\" & strFileName & X & ".txt"
Open strNewFile For Output As #1
' Write the fields' name to the first line.
Print #1, strFieldName & vbCr
End If
rst.MoveNext
Loop
Close #1
Exit_Sub:
Exit Function
Err_FileOpen:
If Err = 55 Then ' File already open
Close #1
Else
MsgBox "Run-time error '" & Err & "':" & _
vbCrLf & vbCrLf & Err.Description, vbOKOnly
End If
Resume Exit_Sub
End Function
เขาต้องการที่จะนำข้อมูลทั้งหมดใน Query เป้าหมาย เพื่อนำไปสร้างเป็นไฟล์ Text โดยสามารถกำหนดว่าจะให้แต่ละไฟล์มีจำนวนข้อมูลมากน้อยแค่ไหนได้ด้วย ดังนี้
1: กำหนดชื่อไฟล์ txt เองได้
2: เลือกจำนวนข้อมูลที่ต้องการในแต่ละไฟล์ได้
3: เริ่มนับจำนวนข้อมูล
4: เริ่มส่งข้อมูลออกไป txt ไฟล์จนกว่าจะครบตามจำนวนที่จำกัดไว้
5: สร้างไฟล์ใหม่ และเริ่มนับจำนวนข้อมูลใหม่
6: แต่ละไฟล์จะต้องมีชื่อฟีลด์ต่างๆ ติดไปด้วยทุกอัน
7: วนจนหมดข้อมูลเป้าหมาย
ผมให้โค้ดเขาไปดังนี้ครับ
Function CreateMultipleFiles(strFileName As String, Optional intX As Integer)
Dim dbs As Object
Dim rst As Object
Dim strData As String, strFieldName As String
Dim strNewFile As String, I As Integer
Dim Y As Integer, X As Integer
'On Error GoTo Err_FileOpen
' If the record limit is left out.
' Limit only 3000 records per file.
If intX = 0 Then
intX = 3000
End If
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Query1")
' Get the fields' name.
For I = 0 To rst.Fields.Count - 1
strFieldName = strFieldName & rst.Fields(I).Name & ", "
Next I
Y = 0
X = 1
' Create the first text file.
strNewFile = "c:\" & strFileName & X & ".txt"
Open strNewFile For Output As #1
' Write the fields' name on the first line.
Print #1, strFieldName & vbCr
Do While Not rst.EOF
' Get each record separated with comma.
For I = 0 To rst.Fields.Count - 1
strData = strData & rst(I) & ", "
Next I
' Write to the text file.
Print #1, strData & vbCr
strData = ""
Y = Y + 1
If Y / intX = 1 Then
' If it reaches the limit of the line, close the file and open the new file.
Close #1
Y = 0
X = X + 1
' Create the first text file.
strNewFile = "c:\" & strFileName & X & ".txt"
Open strNewFile For Output As #1
' Write the fields' name to the first line.
Print #1, strFieldName & vbCr
End If
rst.MoveNext
Loop
Close #1
Exit_Sub:
Exit Function
Err_FileOpen:
If Err = 55 Then ' File already open
Close #1
Else
MsgBox "Run-time error '" & Err & "':" & _
vbCrLf & vbCrLf & Err.Description, vbOKOnly
End If
Resume Exit_Sub
End Function
1 Reply in this Topic. Dispaly 1 pages and you are on page number 1
1 @R06759
Time: 1.0187s