تحويل الجدول الى ملف نصي

Sub Export_Word()

Dim oWord As Word.Application
Dim oDoc As Word.Document
Set oWord = New Word.Application
Set oDoc = New Word.Document

oDoc.ActiveWindow.Selection.Tables.Add Range:=oDoc.ActiveWindow.Selection.Range, numrows:=1, numcolumns:=3
‘numcolumns:= has to be customized

‘Create headers
oDoc.Tables(1).Columns(1).Cells(1).Range.Text = "..title1.."
oDoc.Tables(1).Columns(2).Cells(1).Range.Text = "..title2.."
oDoc.Tables(1).Columns(3).Cells(1).Range.Text = "..title3.."
‘etc.

‘Export data
i=1
Do until EOF.rsData 
	oDoc.Tables(1).Columns(1).Cells.Add
	oDoc.Tables(1).Columns(1).Cells(i + 1).Range.Text = rsData.Fields(1)
	oDoc.Tables(1).Columns(2).Cells(i + 1).Range.Text = rsData.Fields(2)
	oDoc.Tables(1).Columns(3).Cells(i + 1).Range.Text = rsData.Fields(3)
'etc.
	i=i+1
Loop

oDoc.ActiveWindow.Document.SaveAs (“Export.doc")

oDoc.ActiveWindow.Document.Close True
oWord.Quit True
Set oDoc = Nothing
Set oWord = Nothing

End Sub


Sub Export_Excel()

Dim oExcel As Excel.Application
Dim oWB As Excel.Workbook
Dim oWS As Excel.Worksheet

Set oExcel = New Excel.Application
Set oWB = oExcel.Workbooks.Add
Set oWS = oWB.Worksheets(1)

oExcel.Visible = False

'Create headers
oWS.Cells(1, 1) = ".... "
oWS.Cells(1, 2) = "....."
oWS.Cells(1, 3) = "....."

‘Export data
i=1
Do until EOF.rsData 
    oWS.Cells(i + 1, 1) = rsData.Fields(1)
    oWS.Cells(i + 1, 2) = rsData.Fields(2)
    oWS.Cells(i + 1, 3) = rsData.Fields(3)
    'etc.
i = i + 1
Loop

oExcel.DisplayAlerts = False
oWB.SaveAs (Export.xls")
oWB.Close
oExcel.Quit

Set oExcel = Nothing
Set oWB = Nothing
Set oWS = Nothing

End SubEdit by Moderator:

شكرا لك جزيل الشكر اخي الكريم على ردك السريع

ولكن لم تعمل معي حيث انني اريد تحويل البيانات الموجودة في جدول الاكسس الى ملف نصي بنفس التنسيق المحول في ملف الاكسل

وشكرا جزيلا مرة اخرى

مع تحياتي