On Error Resume Next
dim path
dim Cn
dim rs
dim x

set m= createobject("scripting.filesystemobject")
Set Cn = CreateObject("ADODB.connection")
Set RS = CreateObject("ADODB.recordset")
set tablename=CreateObject("ADOX.Catalog")
path=inputbox("enter db name","db full path","enter the fall path and see in the drive c:\")



cn.open("Provider=Microsoft.Jet.OLEDB.4.0;Data Source="+path+"")



tablename.ActiveConnection = cn
For r = 0 To tablename.Tables.Count - 1


If tablename.Tables(r).Type = "TABLE" Then
c=tablename.Tables(r).Name
m.CreateTextFile "c:\"+c+".txt"
set FileStream =m.OpenTextFile("c:\"+c+".txt",2)

rs.Open "select * from ["+tablename.Tables(r).Name+"]", cn, 1, 3
FileStream.WriteLine"connection in form load POWERD BY: MAHMED ABD EL RAHMAN"

FileStream.WriteLine"==================================================="
FileStream.WriteLine"Dim cn As New ADODB.Connection"
FileStream.WriteLine"Dim rs As New ADODB.Recordset"
FileStream.WriteLine"cn.Open("&"""Provider=Microsoft.Jet.OLEDB.4.0;Data Source="+path+""""&")"
FileStream.WriteLine"rs.Open"&"""select * from ["+tablename.Tables(r).Name+"]"""&", cn, 1, 3"
FileStream.WriteLine

FileStream.WriteLine"==================================================="

FileStream.WriteLine
FileStream.WriteLine"rs.AddNew"
for i = 0 to rs.Fields.Count-1
w=i+1
x=("rs!"&rs.Fields(i).Name&"="&"text"& w&".text")
FileStream.WriteLine x
next
FileStream.WriteLine"rs.Update"
FileStream.WriteLine

FileStream.WriteLine

FileStream.WriteLine"==================================================="

FileStream.WriteLine


FileStream.WriteLine
for i = 0 to rs.Fields.Count-1
w=i+1
x=("text"& w&".text"&"="&"rs!"&rs.Fields(i).Name)
FileStream.WriteLine x
next
FileStream.WriteLine
FileStream.WriteLine

FileStream.WriteLine"==================================================="
FileStream.WriteLine"EMAIL BY :LORDOFTHERINGS92001@YAHOO.COM"
rs.close
End If


Next

MsgBox "cheake drive c:\", vbInformation, "create finsh"