Help - Export query to file and split into multiple files
กระทู้เก่าบอร์ด อ.สุภาพ ไชยา

 213   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


1 Reply in this Topic. Dispaly 1 pages and you are on page number 1

1 @R06759
   
@ ประกาศใช้งานเว็บบอร์ดใหม่ => บอร์ดเรียนรู้ Access สำหรับคนไทย
แล้วจะใส่ลิ้งอ้างอิงมาที่โพสต์เก่านี้หรือไม่ก็ตามสะดวกครับ
Time: 0.0451s