استدعاء بيانات من ملف اكسل ووضعها بلست فيو في فيجوال بيسك

السلام عليكم اشعر بالحزن اني لم احصل ولا على اي رد او تلميح لحل المشكله ولذلك سوف اطرح المشكله بشكل ابسط وهو هل يمكن كتابة كود بالفيجيوال بيسك يقوم باستعداء ملف اكسل وقارئته شطر شطر وتخزينه سطر سطر بملف تكست على ان يتم الفصل بين الخلايا بكل سطر بفاصله او فراغ

عند النظر بالمرفقات للموضوع بالاعلى تجدون ملفين تكست واكسل والرماد استدعاء ملف الاكسل ونسخ محتوياته بنفس التنسيق الموجوده عليه محتويات ملف التكست ارجو منكم المساعده ولكم جزيل الشكر.

اختي انا اعرف الطريقة بالاتصال بقاعدة الاكسيل

وربطها ل ولكن لا اعرف اظهارها في ليست فيو

ولكن ممكن ان تضعيها في داتا جريد او شيء من هذا القبيل

وهذا كل ما اعرفة ما رايك؟؟

شكرا الك اخي hamata لكن مشروعي يعتمد على لست فيو ولا يمكني تغيرها الى جريد لان هذا يعني اعادة بناء المشروع كامل من البدياه ولكن هل يمكن ان تساعدني بكود يقوم باستدعاء ملف اكسل ونسخ بياناته بملف تكست سطر سطر .

زاتمنى من لااخوه المساعده ايضا حيث اني وجدت كود للتحويل من تكست لاكسل وليس العكس واتمنى المساعده ببناء كود يقول بتحويل ملف الاكسل المرفق بمشروعي الى ملف تكست ... لكم جزيل الشكر

ساحاول اختي الكريمة

شكرا الك اخي hamata انا ايضا احاول بناء الكود وانتظر مشاركتك معي ومشاركة الاخوه الافاضل لتعم الفائده وشكرا للجميع

السلام عليكم

أختي العزيزة

هذا الكود يقوم بالتحويل من إكسل إلى ملف نصي و لكن غير مجرب بصراحة

Private Sub Command1_Click()
'============================
Dim exl As Excel.Application
Dim wbk As Workbook
Dim filename As String

	Set exl = New Excel.Application
	Set wbk = exl.Workbooks.Add

	filename = exl.GetOpenFilename
	exl.Workbooks.Open filename

	Set wbk = exl.ActiveWorkbook

	filename = exl.GetSaveAsFilename
	If Not Trim(filename) = "False" Then
		wbk.SaveAs filename, xlCurrentPlatformText
	End If

	exl.Quit
	Set wbk = Nothing
	Set exl = Nothing

End Sub

LORD COVER

GOOD BYTE

انتظري اختي جات في دماغي فكرة هايلة

لحظة اجربها

أختي أنا لدي الحل لكن الحل فكرة نظرية وأنت عليك الأكواد وهو أنك تعملين Loop في شرط أنه يسوي اللوب إلى أن يصل لآخر سطر وتضعين داخل هذا Loop أنه يقرأ السطر الأول ومن ثم تضعة في متغير ومن ثم تضعين المتغير في اللست ومن تعاد العملية إلى أن تنتهي القاعدة.

إن شاء الله بعد كم يوم أضع لك الكود.

السلام عليكم اخواني وشكررا لتفاعلكم معي

بعد البحث يمنتديات ومواقع تخص الفيجيوال بيسك 6 وجدت هذا الكود الذي يقوم بتحويل من اكسل الى تكست ولكن بسبب خبرتي البسيطه لم افهم الكود بشكل كامل ولم استطيع تطبيقه وتحويله لمثال بسيط يسهل فهم العمليه لذلك اطلب من خبراء الفيجيوال بيسك مساعتي وتحويل الكود لبرنامج بسيط ارجو المساعده ولكم جزيل الشكر

decleration

Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset

Dim ts As TextStream, fill As File
Dim fso As New FileSystemObject
Dim app As String
Dim i	   As Integer
Dim sFields As String
Dim sData   As String
Dim myPath As String
Dim fld As ADODB.Field
Dim fldCat As String
Dim iSpace	  As Integer
Dim sSourceData As String
Dim currLoc, cnt As Integer
Dim StringLength As Integer
Dim tmpChar As String

´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´
Code

Private Sub Main()
Dim a, b, s, y As Integer

On Error GoTo Form_Load_Error

'To read from the dos prompt
	catch1 = Command$
   'MsgBox catch1
   cnt = 0
  'catch1 = "c:\test.xls Sheet1"


	StringLength = Len(catch1)
	For currLoc = 1 To StringLength

		tmpChar = Mid(catch1, currLoc, 1)

'		If InStr(" ", tmpChar) Then
		If tmpChar = " " Then
			' Replace with a space

			 'Mid(catch1, currLoc, 1) = " "
			 cnt = cnt + 1

		 Else
			 If cnt >= 1 Then
			   app = app & " "
			   cnt = 0
			 End If

			 app = app & tmpChar
		End If


	Next

	catch = app






   a = InStr(1, Trim(catch), "xls")
   b = InStr(1, Trim(catch), "nobypass")
   s = InStr(1, Trim(catch), " ")
   y = InStr(s + 1, Trim(catch), " ")
   'slas = InStr(1, Trim(catch), "\")



 If Val(s) = 0 And Val(y) = 0 Then
  If a > 0 Then
   nm = catch
   fl = Mid$(nm, 1, (Len(nm) - 4)) & ".txt"
   Else
	nm = catch & ".xls"
	fl = catch & ".txt"
  End If
   sh = "Sheet1$"

End If

If Val(y) = 0 And Val(s) <> 0 Then
 If a > 0 Then
  nm = Mid$(catch, 1, s - 1)
  fl = Mid$(nm, 1, (Len(nm) - 4)) & ".txt"
 Else
  nm = Mid$(catch, 1, s - 1) & ".xls"
  fl = Mid$(nm, 1, s - 1) & ".txt"
 End If
  sh = Mid$(catch, s + 1, Len(catch)) & "$"

End If



If Val(s) <> 0 And Val(y) <> 0 Then
 If a > 0 Then
  nm = Mid$(catch, 1, s - 1)
 Else
  nm = Mid$(catch, 1, s - 1) & ".xls"
 End If
  sh = Mid$(catch, Val(s + 1), Val(y - s - 1)) & "$"
  If Val(b) = 0 Then
	  fl = Mid$(catch, Val(y + 1), Len(catch))
   Else
	  fl = Mid$(catch, Val(y + 1), Val(b - y - 1))
  End If
End If



 Set rs = New ADODB.Recordset
 Set cnn = New ADODB.Connection





	   'myPath = "C:\" & nm
		myPath = nm


	'If rs.State = 1 Then rs.Close
	  cnn.Open "Driver={Microsoft Excel Driver (*.xls)};DBQ=" & myPath & ";ReadOnly=1"
	  rs.Open "SELECT * FROM [" & sh & "]", cnn


	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ts = fs.CreateTextFile(fl, True)


  Do While Not rs.EOF
  i = 0
		For Each fld In rs.Fields

		If Val(b) > 0 Then
		  fldCat = fldCat & IIf(IsNull(fld), "|", fld & "|")
		Else
		  If IsNull(fld) = True Then
			Else
			 'fldCat = fldCat & fld & "|"
			 If i = 0 Then
			   fldCat = fldCat & fld
			  Else
			  fldCat = fldCat & "|" & fld
			 End If
			 i = i + 1
		   End If
		End If
		Next

		 If i <> 0 Then
			ts.WriteLine (Trim(fldCat))
		 End If

		  fldCat = ""
		  rs.MoveNext
  Loop


  ts.Close

'  Open " & x & " For Input As #1
'
'  Close 1#



   On Error Resume Next
   If Not rs Is Nothing Then
	 rs.Close




   Set rs = Nothing
   End If

	If Not cnn Is Nothing Then
	  cnn.Close
	Set cnn = Nothing
	End If

   On Error GoTo 0




'Form_Load_Exit:
   Exit Sub

Form_Load_Error:

   MsgBox "Usage   : Excel-File [Sheet Output nobypass] " & vbCrLf & _
		  "Example: cett xyz.xls sheet1 out.txt				 -create out.txt from xyz.xls sheet1 sheet" & vbCrLf & Space(13) & _
		  "  cett xyz.xls jan jan.txt					   -create jan.txt from xyz.xls jan sheet " & vbCrLf & _
		  "			   cett xyz											-create xyz.txt from xyz.xls sheet1 sheet " & vbCrLf & _
		  "			   cett xyz.xls exp exp.txt nobypass	 -create exp.txt from xyz.xls exp sheet" & vbCrLf & _
		  "																		without bypassing the blank lines ", , "CETT : Convert Excel To Text"


End Sub

جارى وضع الحل ان شاء الله

هذا برنامج سبق أن وضعه أحد الزملاء بالمنتدى يقوم بتحويل البيانات الموجودة فى صفحة اكسيل الى قاعدة بيانات أكسيس

و بالتالى يمكن التعالم معها بسهولة حينئذ من خلال الفجوال بيسيك

وأى خدمة نحن تحت أمركم

مقابل ذلك هو دعواتكم لنا و للمسلمين جميعا

excelToAccess.rar

شكرا الك اخي احمد وليد معقول الاقي حل لهلمشكله لاني كثير تعبت وانا بجرب وبدور

عن جد شكرا الك وللكل الي دخله وحاوله يساعدوني

اخي العزيز انا شوفت المثال هذا او اشي مشابه لكن ما اريده هو مختلف تماما

اريد ان اقوم بتحديد مشار ملف الاكسل ويكون موجود باي مكان على جهازي ممكن على دي او سي او دسك توب وبعد ذلك وبالضغط على زر معين يقوم بقراءة محتويات ملف الاكسل وتصديرها الى ملف تكست على ان تصدر سطر سطر ويفصل بين محتويات الخلايا بفاصله او نقطه وبذلك يمكني استخدام ملف التكست بمشروعي

هذه هي مشكلتي انا قمت بوضع كود في هذا الموضوع ولكني لم استطيع التعامل معه لانه من موقع اجنبي وغير واضح اتمنى ان تكون قد فهمت مشكلتي ولك جزيل الشكر

لحظة اختي دي سهلة اعدليك المثال

تفضلي اختي

عمللتيلك فتح ملف وتشغيله

وببحث الان عن الكود بتاع التحويل

project_file1.rar

بسم الله الرحمن الرحيم

الى الاخت العزيزه صاحبه الموضوع

الامر اسهل من المتوقع لانك هتغيرى امتداد الملف بدلا من goods.txt الى goods.xls

و ممكن تغيرى المكان للملف الى انتى عايزاه بكتابه الكود فى txt box

مثال

Open App.Path = txt10.txt "\txt11.txt" For Input As #1

Seek #1, 1

و طبعا علشان اامكان الى انتى هتكتبيه يبقى فعال لازم تضيفى timer علشان يعمل connect سريع

,و جربى و مش هتخسرى حاجه

و انا بحاول اعدل فى الاكواد و هرفق كل التعديلات لما اخلص

اخوكم محمد صبحى

مبتداء

Excel2Text.rar

New_Folder__2_.rar

form.ppt

اختي البرنامج فعلا حول

بس الليست فيو ما يقرأها

يعني عايزين كود مخصوص

او تعملي البرنامج يقرا من الاكسيل

عموما هشوف كده علي بكرة او بعده

اخي الكريم مشكلة اللست فيو بحلها بس بدي برنامج بسيط يحدد مسار ملف الاكسل وبالضغط على زر يقوم بنسخ البيانات من ملف الاكسل الى ملف التكست والنسخ يتم سطر سطر وبين محتويات الخلايا في السطر الواحد يفصل بينها بفاصله او نقطه او اي شيء

ما تهتم بمشكلة اللست فيو اطلع على شكل النموذج المرفق بالاعلى بالصوره وسوف تعرف ما احتاج بالزبط وانا بحل مشكلة اللست فيو

عموما هحاول واقوليك

شكرا اخ حماده لاهتمامك وبتمنى من الجميع المساعده في الحل وشكرا لكل الي حاول معي

:(

استني في حل اجربة الان

بس كل حقل في تكسيت (ملف نصي)

لم تنجح ...................... :(