txt den çalışma kitabının ilk sayfasına verileri alma

[eftel]

Herkese merhaba,
Txt dosyasından açık bulunan excel kitabının aktif çalışma sayfasına verileri nasıl alabilirirm.TXT dosyasının secimini diyalog kutusu açılarak almam gerekli.

Private Sub CommandButton1_Click()
Dim X As Variant
X = Application.GetOpenFilename _
("Text Files (*.txt), *.txt, Add-in Files (*.xla), *.xla", 0, _
"Open My Files", , True)
For Y = 1 To UBound(X)
Workbooks.Open X(Y)
Next
End Sub

bu kodu kullanıyorum ama verileri attığımda başka bir excel sayfası olarak acıyor, yani sectiğim txt dosyasının adını almış halde excel sayfası oluşturuyor. Ayrı bir kitap değilde çalıştığım excel sayfasının ilk sayfasına yazdırmasını istiyorum. Kodda bana yardımcı olabilir misiniz.
Saygılar.

 

[Murat OSMA]

Ado ile verileri şu şekilde alabilirsiniz;

Sub Txtdenverial()
    Dim fname, yol As String, dosya As String
    Dim con As Object, rs As Object
    Rem ExcelVBA.Net - 21-09-2011
    fname = Application.GetOpenFilename("Text Dosyaları,*.txt")
    If fname = False Then Exit Sub
    yol = Mid(fname, 1, InStrRev(fname, "\", -1, 1))
    dosya = Replace(fname, yol, "")
    Set con = CreateObject("adodb.connection")
    con.Open "provider=microsoft.jet.oledb.4.0;data source=" & _
    yol & ";Extended Properties =""text;HDR=Yes;FMT=Delimited"""
    Set rs = CreateObject("adodb.recordset")
    rs.Open "select * from " & dosya, con, 1, 1
    Cells.Clear
    If rs.RecordCount > 0 Then
    Range("a1").CopyFromRecordset rs
    End If
    Columns.AutoFit
    rs.Close: Set rs = Nothing
    con.Close: Set con = Nothing
    yol = vbNullString: dosya = vbNullString: fname = vbNullString
End Sub

 

[Korhan Ayhan]

Merhaba,

Alternatif olarak aşağıdaki linki inceleyiniz.

Txt dosyasından veri alma ve kaydetme

 

[eftel]

Teşekkürler cevaplar için sanırım şu kod işimi gördü :

Dim sh As Worksheet
Dim dosya As Variant
Dim satir As String
Set sh = Sheets("Data")
ChDir ThisWorkbook.Path

Dim deger As String
sn = sh.Cells(65536, 1).End(xlUp).Row + 1
Dim FSO As Object
dosya = Application.GetOpenFilename("Metin dosyası (*.txt),*.txt", , "Hedef Dosyayı Seçin")
If dosya = False Then Exit Sub
sh.Range("a1:a" & sn + 1).ClearContents
st = 2
Application.ScreenUpdating = False
Open dosya For Input Access Read As #1
While Not EOF(1)
Line Input #1, satir
satir = Replace(satir, "<name>", "", 1, -1, vbTextCompare)
satir = Replace(satir, "</name>", "", 1, -1, vbTextCompare)
sh.Cells(st, "a") = satir
st = st + 1
Wend
Close #1

doğrudan çalışma kitabının ilk sayfasına kopyalıyor.