انتقال از ورد به اکسس

[narese]

سلام دوستان
یک فایل ورد دارم که نویسنده آن به جای اینکه جدول درست کنه و رکورد ها را در آن قرار بده،بین هر رکورد علامت****************را گذاشته.حالا من برای بردن این رکورد ها که تعدادشون زیاده مجبورم یکی یکی اونا رو توی اکسس کپی کنم.
می خواستم از شما دوستان و اساتید بپرسم که آیا کدی هست که من بتونم بطور اتوماتیک مطالب میان علامت ستاره ها را توی یک رکورد قرار بدم

[شاگرد آرام]

سلام
اگه فایل نمونه ورد رو بزارید شاید بهتر بشه مسئله رو حل کرد

[narese]

یک نمونه فایل ورد گذاشتم
میخواستم هر رکورد را بطور خودکار در یک رکورد اکسس قرار بدم.البته تعداد خیلی بیشتره حدود 10000 رکورد میشه

132914

[alirezabahrami]

یک نمونه فایل ورد گذاشتم
میخواستم هر رکورد را بطور خودکار در یک رکورد اکسس قرار بدم.البته تعداد خیلی بیشتره حدود 10000 رکورد میشه

132914
سلام
قدری پیچیده است ولی شدنیه
فقط در حد یک راهنمائی بسنده می کنم:
اگر ترتیب نوشته ها در فایل ورد به همین صورت فایل نمونه است که ارسال کرده اید:
1- کل نوشته ها را انتخاب و کپی و آن را در یک ستون فایل اکسل پیست کن
2- سطرهای ستاره دار را از ستون مربوطه حذف کن
3- از داخل برنامه اکسس فایل یک ستونی اکسل را ایمپورت کن
4- در قسمت کوئری با استفاده از تابع split و تابع left اقدام به تفکیک شرح موارد (نوع جنس، قیمت، موجودی)کن
5- موارد سه کوئری ایجاد شده را در یک جدول دیگر که دارای فیلدهای نوع جنس، قیمت، موجودی است وارد کن
یا علی

[narese]

ممنون ولی اگر امکان داره کمی عملی تر توضیح بدید.

[شاگرد آرام]

دوست عزیز
منم یک پیشنهاد دارم
جدولی بسازید به نام table1 با سه فیلد به نامهای fld1 fld2 fld3 فایل وردتون رو تغییر نام بدید داخل درایو d بزارید به نام la.docx
کد زیر رو در فایل اکسس اجرا کنید

Sub fw()
On Error Resume Next
Dim rs As Recordset

Set rs = CurrentDb.OpenRecordset("table1")

Set w = CreateObject("Word.Application")
Set dc = w.Documents.Open("d:\la.docx")


For t = 1 To dc.Paragraphs.Count
sr = dc.Paragraphs(t).Range.Text

If Left(sr, 3) = "***" Then
rs.AddNew

sr = dc.Paragraphs(t + 1)
n = InStr(1, sr, ":", vbTextCompare)
rs!fld1 = Right(sr, Len(sr) - n)

sr = dc.Paragraphs(t + 2)
n = InStr(1, sr, ":", vbTextCompare)
rs!fld2 = Right(sr, Len(sr) - n)

sr = dc.Paragraphs(t + 3)
n = InStr(1, sr, ":", vbTextCompare)
rs!fld3 = Right(sr, Len(sr) - n)

rs.Update



End If


Next

dc.Close
Set w = Nothing
End Sub

[narese]

متشکر ولی کد مشکل دارد .چطور میشه حلش کرد

[شاگرد آرام]

دوست عزیز
اگه مبخواهید کد زیر دکمه اجرا بشه خط fw() sub کد رو حذف کنید

[nazanin_90]

دوست عزیز
منم یک پیشنهاد دارم
جدولی بسازید به نام table1 با سه فیلد به نامهای fld1 fld2 fld3 فایل وردتون رو تغییر نام بدید داخل درایو d بزارید به نام la.docx
کد زیر رو در فایل اکسس اجرا کنید

Sub fw()
On Error Resume Next
Dim rs As Recordset

Set rs = CurrentDb.OpenRecordset("table1")

Set w = CreateObject("Word.Application")
Set dc = w.Documents.Open("d:\la.docx")


For t = 1 To dc.Paragraphs.Count
sr = dc.Paragraphs(t).Range.Text

If Left(sr, 3) = "***" Then
rs.AddNew

sr = dc.Paragraphs(t + 1)
n = InStr(1, sr, ":", vbTextCompare)
rs!fld1 = Right(sr, Len(sr) - n)

sr = dc.Paragraphs(t + 2)
n = InStr(1, sr, ":", vbTextCompare)
rs!fld2 = Right(sr, Len(sr) - n)

sr = dc.Paragraphs(t + 3)
n = InStr(1, sr, ":", vbTextCompare)
rs!fld3 = Right(sr, Len(sr) - n)

rs.Update



End If


Next

dc.Close
Set w = Nothing
End Sub
با سلام
بعد از اجرا جدول باید سه رکورد مربوط به (شیر پاستوریزه ، سرکه ، خیار شور ) داشته باشد ولی دو رکورد در جدول به نمایش در می آید .
موفق باشید

[narese]

تشکر از شاگرد آرام
فقط یک مورد را هنوز مشکل دارم اینکه گاهی زیر هر موردی توضيحات هم نوشته شده که معلوم نيست چند پاراگراف باشد،می خواهم از پاراگراف چهارم به بعد هر تعداد مطلب و پاراگراف بود ،همه را در یک فیلد قرار دهد .نمونه توضیحات در ضمیمه آمده

[narese]

دوستان کسی نمیدونه مشکل چطوری حل میشه

[narese]

من نیاز مبرم به این کد دارم .لطفا کمک کنید

[narese]

بالاخره درست شد کد مورد نظر رابرای کسانی که نیاز داردند می گذارم


Private Sub Command0_Click()
On Error Resume Next
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("table1")
Set w = CreateObject("Word.Application")
Set dc = w.Documents.Open("d:\la.docx")

For t = 1 To dc.Paragraphs.Count
sr = dc.Paragraphs(t).Range.Text



If Left(sr, 3) = "***" Then
rs.AddNew
sr = dc.Paragraphs(t + 1)
n = InStr(1, sr, ":", vbTextCompare)
rs!fld1 = Right(sr, Len(sr) - n)

sr = dc.Paragraphs(t + 2)
n = InStr(1, sr, ":", vbTextCompare)
rs!fld2 = Right(sr, Len(sr) - n)

sr = dc.Paragraphs(t + 3)
n = InStr(1, sr, ":", vbTextCompare)
rs!fld3 = Right(sr, Len(sr) - n)

sr = dc.Paragraphs(t + 4)
n = InStr(1, sr, ":", vbTextCompare)
rs!fld4 = Right(sr, Len(sr) - n)
' --------------------------------------- Farshid:
txt = ""
For k = 2 To 500
sr = dc.Paragraphs(t + 3 + k)
If Left(sr, 3) <> "***" Then
txt = txt & sr
Else
Exit For
End If
Next k
rs!Description = txt
' --------------------------------------- Farshid /

rs.Update
End If
Next
dc.Close
w.Close
Set w = Nothing
MsgBox "عمليات به پايان رسيد"
End Sub