[فوری] خواندن فایل تکست و تبدیل آن به فایل اکسل توسط CommandButton

[ahmadelectron]

سلام دوستان
دار م یه برنامه مینویسم که :
1. ابتدا فایل تکست را توسط CommandButton بصورت Browse دریافت کنه
2. اون فایل تکست دریافتی را به یک فایل اکسل تبدیل کنه
حالا من، تونستم قسمت شماره 2 را بصورت کامل انجام بدم منتهی توی این کدی که نوشتم، آدرس فایل تکست ثابته که من میخوام هر فایل تکست دلخواهی را Browse کنم و تبدیل به یه فایل اکسل بشه.
اینم از کدهای نوشته شده:

کد:

Private Sub Command1_Click()
CommonDialog1.fliter = "Apps (*.txt)|*.txt|All files (*.*)|*.*"
CommonDialog1.DefaultExt = "txt"
CommonDialog1.DialogTitle = "Select File"
CommonDialog1.ShowOpen

MsgBox CommonDialog1.FileName

Set objFile = objFSO.OpenTextFile(CommonDialog1.FileName, ForReading)
End Sub

Private Sub Command2_Click()
Dim objUser, strExcelPath, objExcel, objSheet, _
objFSO, objFile, aline, aLines, irow, icol

Const ForReading = 1

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\1.txt", _
ForReading)
strExcelPath = "C:\testing.xls"

' Bind to Excel object.
'On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Excel application not found."
Wscript.Quit
End If
On Error GoTo 0

objExcel.Visible = True
objExcel.Workbooks.Add

Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
objSheet.Name = "testing"

aLines = Split(objFile.ReadAll, vbNewLine)
For irow = 1 To UBound(aLines) + 1
aline = Split(aLines(irow - 1), ",")
For icol = 1 To UBound(aline) + 1
objSheet.Cells(irow, icol).Value = aline(icol - 1)
Next ' icol
Next ' irow
End Sub

ون کلید Command2 فایل تکست را به اکسل تبدیل میکنه ولی ایرادش اینه که آدرس فایل باید مشخص باشه، حالا من میخوام با کلید Command1 فایل تکست را لود کنم و به اون تابع کلید Command2 بدهم تا فایل تکست را بخونه و تبدیلش کنه
کل فایلهای پروژ] به زبان VB6 را ضمیمه کردم، ممنون میشم نگاهی بندازین
http://s3.picofile.com/file/8190381342/T...S.zip.html

[Ghoghnus]

سلام من ویژال بیسیک نصب ندارم روی سیستم ولی کد شما به این شکل میشه!

کد:

Private Sub Command1_Click()
CommonDialog1.fliter = "Apps (*.txt)|*.txt|All files (*.*)|*.*"
CommonDialog1.DefaultExt = "txt"
CommonDialog1.DialogTitle = "Select File"
CommonDialog1.ShowOpen

MsgBox CommonDialog1.FileName

Set objFile = objFSO.OpenTextFile(CommonDialog1.FileName, ForReading)
End Sub

Private Sub Command2_Click()

CommonDialog1.DefaultExt = "xls"

CommonDialog1.ShowSave

Dim objUser, strExcelPath, objExcel, objSheet, _
objFSO, objFile, aline, aLines, irow, icol

Const ForReading = 1

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\1.txt", _
ForReading)
strExcelPath = "CommonDialog1.FileName"

' Bind to Excel object.
'On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Excel application not found."
Wscript.Quit
End If
On Error GoTo 0

objExcel.Visible = True
objExcel.Workbooks.Add

Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
objSheet.Name = "testing"

aLines = Split(objFile.ReadAll, vbNewLine)
For irow = 1 To UBound(aLines) + 1
aline = Split(aLines(irow - 1), ",")
For icol = 1 To UBound(aline) + 1
objSheet.Cells(irow, icol).Value = aline(icol - 1)
Next ' icol
Next ' irow
End Sub