• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kapalı dosyada bağlantı hatası?

S

s.savas

Katılım
12 Ocak 2009
Mesajlar
838
Excel Vers. ve Dili
2003
Dostlar Ofis 2003 te hazırladığım çalışma kitabım kapalı dosyaya bağlantıda hata veriyor. Aynı dosya Ofis 2007 de hata vermiyor.
Kod: 
Private Sub ComboBox1_Change()
ListBox1.Clear
yol = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\Adres-Telefon Rehberi.xls;Extended Properties=""Excel 12.0;HDR=no;IMEX=1"";"
Set baglanti = CreateObject("ADODB.Connection")
[B][U]baglanti.Open yol[/U][/B]
Set rs = baglanti.Execute("select*from [veri$b2:b65536] where F1 like '" & ComboBox1 & "%' order by F1")
If rs.BOF = False Then ListBox1.Column = rs.GetRows
rs.Close
baglanti.Close
End Sub

Hata kaynağı altı çizili satırda veriyor.
Yardımlarınızı rica ediyorum.
 
s.savas' Alıntı:
Dostlar Ofis 2003 te hazırladığım çalışma kitabım kapalı dosyaya bağlantıda hata veriyor. Aynı dosya Ofis 2007 de hata vermiyor.
Kod: 
Private Sub ComboBox1_Change()
ListBox1.Clear
yol = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\Adres-Telefon Rehberi.xls;Extended Properties=""Excel 12.0;HDR=no;IMEX=1"";"
Set baglanti = CreateObject("ADODB.Connection")
[B][U]baglanti.Open yol[/U][/B]
Set rs = baglanti.Execute("select*from [veri$b2:b65536] where F1 like '" & ComboBox1 & "%' order by F1")
If rs.BOF = False Then ListBox1.Column = rs.GetRows
rs.Close
baglanti.Close
End Sub

Hata kaynağı altı çizili satırda veriyor.
Yardımlarınızı rica ediyorum.
Genişletmek için tıkla ...

İlgili satırı aşağıdaki ile değiştirin.
Kod: 
yol = "Provider=[B][COLOR="Red"]Microsoft.jet.OLEDB.4.0[/COLOR][/B];Data Source=" & ThisWorkbook.Path & "\Adres-Telefon Rehberi.xls;Extended Properties=""Excel 12.0;HDR=no;IMEX=1"";"
 
Evren Gizlen' Alıntı:
İlgili satırı aşağıdaki ile değiştirin.
Kod: 
yol = "Provider=[B][COLOR="Red"]Microsoft.jet.OLEDB.4.0[/COLOR][/B];Data Source=" & ThisWorkbook.Path & "\Adres-Telefon Rehberi.xls;Extended Properties=""Excel 12.0;HDR=no;IMEX=1"";"
Genişletmek için tıkla ...

Evren hocam aynı hata mesajı devam ediyor.
 
s.savas' Alıntı:
Evren hocam aynı hata mesajı devam ediyor.
Genişletmek için tıkla ...
Gerçi zeki hocam link vermiş.
Ama aşğaıdaki gibi denermisiniz.
Ben excel 12.0 yerine excel 8.0 yazmayı unutmuşum.:cool:
Kod: 
yol = "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\Adres-Telefon Rehberi.xls;Extended Properties=""Excel [B][COLOR="Red"][SIZE="3"]8.0[/SIZE][/COLOR][/B];HDR=no;IMEX=1"";"
 
Evren Gizlen' Alıntı:
Gerçi zeki hocam link vermiş.
Ama aşğaıdaki gibi denermisiniz.
Ben excel 12.0 yerine excel 8.0 yazmayı unutmuşum.:cool:
Kod: 
yol = "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\Adres-Telefon Rehberi.xls;Extended Properties=""Excel [B][COLOR="Red"][SIZE="3"]8.0[/SIZE][/COLOR][/B];HDR=no;IMEX=1"";"
Genişletmek için tıkla ...

Teşekkürler üstat sorun çözüldü.
Zeki hocaya da ayrıca teşekkür ediyorum.
 
Evren Gizlen' Alıntı:
Rica ederim.
İyi çalışmalar.:cool:
Genişletmek için tıkla ...

Evren hocam yeni konu açmadan, konuyla alakalı bir soru sormak istiyorum.
Formda yaptığım aramalar sonucu, kapalı dosyalarla ilgili olarak sorulan sorular ve verilen cevaplarda, kapalı ve açık dosyaların sürekli olarak A1, B1, C1 vb sütunundan veri aldığı ve veri kaydetmeye de aynı şekilde A1,B1,C1 sütunlarına veri yazdığını görüyorum.
Benim amacım, sadece kapalı dosyadaki G17 hücresini, açık dosyadaki G17 hücresine yazdırmak istiyorum.
İyi akşamlar diliyorum.
 

Ekli dosyalar

s.savas' Alıntı:
Evren hocam yeni konu açmadan, konuyla alakalı bir soru sormak istiyorum.
Formda yaptığım aramalar sonucu, kapalı dosyalarla ilgili olarak sorulan sorular ve verilen cevaplarda, kapalı ve açık dosyaların sürekli olarak A1, B1, C1 vb sütunundan veri aldığı ve veri kaydetmeye de aynı şekilde A1,B1,C1 sütunlarına veri yazdığını görüyorum.
Benim amacım, sadece kapalı dosyadaki G17 hücresini, açık dosyadaki G17 hücresine yazdırmak istiyorum.
İyi akşamlar diliyorum.
Genişletmek için tıkla ...
Bu türden yığınla çözüm var forumda.
Demekki siz rastlamamışsınız.Forumda sorulmayan soru yoktur.Her türlü soru sorulmuş ve çeşitli varyantlarda cevabı verilmiştir.
Dosyanız ektedir.:cool:
Kod: 
Sub g17_al()
Sheets("Sayfa1").Range("G17").Value = _
Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[Kapalı.xls]Sayfa1'!R17C7")
MsgBox "Kapalı.xls dosyasındadaki sayfa1 deki G17 hücresindeki veri" & vbLf & _
"Sayfa1 de G17 hücresine aktarıldı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "EVREN"
End Sub
 

Ekli dosyalar

Kapalı Dosya..

Evren hocam sizden bir ricam daha olabilirmi.
Kod: 
Private Sub ComboBox1_Change()
ListBox1.Clear
yol = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "[B][U][COLOR="Red"]\Adres-Telefon Rehberi.xls[/COLOR][/U][/B];Extended Properties=""Excel 12.0;HDR=no;IMEX=1"";"
Set baglanti = CreateObject("ADODB.Connection")
baglanti.Open yol
Set rs = baglanti.Execute("select*from [veri$b2:b65536] where F1 like '" & ComboBox1 & "%' order by F1")
If rs.BOF = False Then ListBox1.Column = rs.GetRows
rs.Close
baglanti.Close
End Sub

Kaynak dosyanın yolunu biz burada tanımlamazsan, bize kaynak dosyanın yolunu nasıl sordururuz. Yani excell bize veri alacağı kapalı dosyanın nerede olduğunu sorsun.
Saygılar.
 
s.savas' Alıntı:
Evren hocam sizden bir ricam daha olabilirmi.
Kod: 
Private Sub ComboBox1_Change()
ListBox1.Clear
yol = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "[B][U][COLOR="Red"]\Adres-Telefon Rehberi.xls[/COLOR][/U][/B];Extended Properties=""Excel 12.0;HDR=no;IMEX=1"";"
Set baglanti = CreateObject("ADODB.Connection")
baglanti.Open yol
Set rs = baglanti.Execute("select*from [veri$b2:b65536] where F1 like '" & ComboBox1 & "%' order by F1")
If rs.BOF = False Then ListBox1.Column = rs.GetRows
rs.Close
baglanti.Close
End Sub

Kaynak dosyanın yolunu biz burada tanımlamazsan, bize kaynak dosyanın yolunu nasıl sordururuz. Yani excell bize veri alacağı kapalı dosyanın nerede olduğunu sorsun.
Saygılar.
Genişletmek için tıkla ...

:cool:
Kod: 
ListBox1.Clear
ChDir ("C:\")
dosya = Application.GetOpenFilename(FileFilter:="Excel dosyaları,*.xls", Title:="Dosyayı seçiniz   evrengizlen@hotmail.com")
If dosya = False Then
    MsgBox "Bir seçim yapmadınız.İşlem iptal edildi", vbCritical, "UYARI"
    Exit Sub
End If
Set baglanti = CreateObject("ADODB.Connection")
baglanti.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dosya & _
";Extended Properties=""Excel 12.0;HDR=no;IMEX=1"";"
Set rs = baglanti.Execute("select*from [veri$b2:b65536] where F1 like '" & ComboBox1 & "%' order by F1")
If rs.BOF = False Then ListBox1.Column = rs.GetRows
rs.Close
baglanti.Close
 
Evren Gizlen' Alıntı:
:cool:
Kod: 
ListBox1.Clear
ChDir ("C:\")
dosya = Application.GetOpenFilename(FileFilter:="Excel dosyaları,*.xls", Title:="Dosyayı seçiniz   evrengizlen@hotmail.com")
If dosya = False Then
    MsgBox "Bir seçim yapmadınız.İşlem iptal edildi", vbCritical, "UYARI"
    Exit Sub
End If
Set baglanti = CreateObject("ADODB.Connection")
baglanti.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dosya & _
";Extended Properties=""Excel 12.0;HDR=no;IMEX=1"";"
Set rs = baglanti.Execute("select*from [veri$b2:b65536] where F1 like '" & ComboBox1 & "%' order by F1")
If rs.BOF = False Then ListBox1.Column = rs.GetRows
rs.Close
baglanti.Close
Genişletmek için tıkla ...

Evren hocam ilginiz için tekrar teşekkür ediyorum. Kod sorunsuz çalışıyor ancak her işlem için kaynak dosyanın yolunu göstermek durumunda kalıyoruz. Son gösterilen yolun hatırlanması sağlanabilirmi, bu mümkün değilse kaynak dosyanın masa üstünde bulunduğunu farzedip kodu buna göre düzenleyebilirmiyiz.
 
s.savas' Alıntı:
Evren hocam ilginiz için tekrar teşekkür ediyorum. Kod sorunsuz çalışıyor ancak her işlem için kaynak dosyanın yolunu göstermek durumunda kalıyoruz. Son gösterilen yolun hatırlanması sağlanabilirmi, bu mümkün değilse kaynak dosyanın masa üstünde bulunduğunu farzedip kodu buna göre düzenleyebilirmiyiz.
Genişletmek için tıkla ...
Dosya yolu ilk sayfada A1 hücresinde tutuluyor.
Eğer boşsa C:\ kök dizini açılıyor.

Kod: 
ListBox1.Clear
If Sheets(1).Range("A1").Value = "" Then Sheets(1).Range("A1").Value = "C:\"
On Error GoTo hata
ChDir (Sheets(1).Range("A1").Value)
dosya = Application.GetOpenFilename(FileFilter:="Excel dosyaları,*.xls", Title:="Dosyayı seçiniz   evrengizlen@hotmail.com")
If dosya = False Then
    MsgBox "Bir seçim yapmadınız.İşlem iptal edildi", vbCritical, "UYARI"
    Exit Sub
End If
Sheets(1).Range("A1").Value = Left(dosya, Len(dosya) - Len(Dir(dosya)) - 1)
Set baglanti = CreateObject("ADODB.Connection")
baglanti.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dosya & _
";Extended Properties=""Excel 12.0;HDR=no;IMEX=1"";"
Set rs = baglanti.Execute("select*from [veri$b2:b65536] where F1 like '" & ComboBox1 & "%' order by F1")
If rs.BOF = False Then ListBox1.Column = rs.GetRows
rs.Close
baglanti.Close
Exit Sub
hata:
MsgBox "[ " & Sheets(1).Name & "!A1 Hücresinde yazılı olan yol = [ " & Sheets(1).Range("A1").Value & " ] sürücünüzde yoktur.", vbCritical, "YOL YOK"
 
Evren Gizlen' Alıntı:
Dosya yolu ilk sayfada A1 hücresinde tutuluyor.
Eğer boşsa C:\ kök dizini açılıyor.

Kod: 
ListBox1.Clear
If Sheets(1).Range("A1").Value = "" Then Sheets(1).Range("A1").Value = "C:\"
On Error GoTo hata
ChDir (Sheets(1).Range("A1").Value)
dosya = Application.GetOpenFilename(FileFilter:="Excel dosyaları,*.xls", Title:="Dosyayı seçiniz   evrengizlen@hotmail.com")
If dosya = False Then
    MsgBox "Bir seçim yapmadınız.İşlem iptal edildi", vbCritical, "UYARI"
    Exit Sub
End If
Sheets(1).Range("A1").Value = Left(dosya, Len(dosya) - Len(Dir(dosya)) - 1)
Set baglanti = CreateObject("ADODB.Connection")
baglanti.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dosya & _
";Extended Properties=""Excel 12.0;HDR=no;IMEX=1"";"

Set rs = baglanti.Execute("select*from [veri$b2:b65536] where F1 like '" & ComboBox1 & "%' order by F1")
If rs.BOF = False Then ListBox1.Column = rs.GetRows
rs.Close
baglanti.Close
Exit Sub
hata:
MsgBox "[ " & Sheets(1).Name & "!A1 Hücresinde yazılı olan yol = [ " & Sheets(1).Range("A1").Value & " ] sürücünüzde yoktur.", vbCritical, "YOL YOK"
Genişletmek için tıkla ...

Evren hocam teşekkür ederim ilginize.
Yukarıdaki kod ile Listbox'a kaynak dosyadaki verileri alıyoruz, ancak listbox'a alınan veriler textbox'lara aktarılamıyor. Sorunun kaynağı zannediyorum aşağıdaki koda göre açık ve kapalı dosyanında aynı yolda olması gerektiğinden.
Kod: 
Private Sub ListBox1_Click()
On Error Resume Next
For a = 1 To 8
Controls("textbox" & a) = ""
Next
[B][U]yol = "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\Adres-Telefon Rehberi.xls;Extended Properties=""Excel 8.0;HDR=no;IMEX=1"";"[/U][/B]
Set baglanti = CreateObject("ADODB.Connection")
baglanti.Open yol
Set rs = baglanti.Execute("select*from [veri$A2:P65536] where F2 like '" & ListBox1 & "%' order by F2")
TextBox1 = rs.fields(1)
TextBox2 = rs.fields(2)
TextBox3 = rs.fields(3)
TextBox4 = rs.fields(5)
TextBox5 = rs.fields(9)
TextBox6 = rs.fields(11)
TextBox7 = rs.fields(14)
TextBox8 = rs.fields(15)
rs.Close
baglanti.Close
End Sub

Bu koddaki dosya yolunu da, yukarıdaki gibi düzenleyebilirmiyiz.
 
s.savas' Alıntı:
Evren hocam teşekkür ederim ilginize.
Yukarıdaki kod ile Listbox'a kaynak dosyadaki verileri alıyoruz, ancak listbox'a alınan veriler textbox'lara aktarılamıyor. Sorunun kaynağı zannediyorum aşağıdaki koda göre açık ve kapalı dosyanında aynı yolda olması gerektiğinden.
Kod: 
Private Sub ListBox1_Click()
On Error Resume Next
For a = 1 To 8
Controls("textbox" & a) = ""
Next
[B][U]yol = "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\Adres-Telefon Rehberi.xls;Extended Properties=""Excel 8.0;HDR=no;IMEX=1"";"[/U][/B]
Set baglanti = CreateObject("ADODB.Connection")
baglanti.Open yol
Set rs = baglanti.Execute("select*from [veri$A2:P65536] where F2 like '" & ListBox1 & "%' order by F2")
TextBox1 = rs.fields(1)
TextBox2 = rs.fields(2)
TextBox3 = rs.fields(3)
TextBox4 = rs.fields(5)
TextBox5 = rs.fields(9)
TextBox6 = rs.fields(11)
TextBox7 = rs.fields(14)
TextBox8 = rs.fields(15)
rs.Close
baglanti.Close
End Sub

Bu koddaki dosya yolunu da, yukarıdaki gibi düzenleyebilirmiyiz.
Genişletmek için tıkla ...

Tespitiniz yanlış.
Söylediğiniz şeyle listboxtan verileri textboxa aktarma konusunda hiç bir ilişki yoktur.
Listboxa aldığınız verileri aşağıdaki kodlarla textboxlara atabilirsiniz.
Not:
Listboxınızda 8 kolon olmalı ve en az 8 tane textboxınız olmalı ve Textboxlarınızın ismi 1 den 8 e kadar ardaşık olmalı ,TextBox1....TextBox8 şeklinde olmalı.
Kod: 
Private Sub ListBox1_Click()
If ListBox1.ListCount < 1 Then Exit Sub
For a = 1 To 8
Controls("textbox" & a) = ListBox1.Column(a - 1)
Next
End Sub
 
Evren Gizlen' Alıntı:
Tespitiniz yanlış.
Söylediğiniz şeyle listboxtan verileri textboxa aktarma konusunda hiç bir ilişki yoktur.
Listboxa aldığınız verileri aşağıdaki kodlarla textboxlara atabilirsiniz.
Not:
Listboxınızda 8 kolon olmalı ve en az 8 tane textboxınız olmalı ve Textboxlarınızın ismi 1 den 8 e kadar ardaşık olmalı ,TextBox1....TextBox8 şeklinde olmalı.
Kod: 
Private Sub ListBox1_Click()
If ListBox1.ListCount < 1 Then Exit Sub
For a = 1 To 8
Controls("textbox" & a) = ListBox1.Column(a - 1)
Next
End Sub
Genişletmek için tıkla ...

Evren hocam mahçup bir şekilde başaramadığımı ifade etmek istiyorum.
Dediğiniz gibi Kod anlatılmaz yazılır.

En son yazdığınız kodlar şöyledir.
Kod: 
Private Sub ComboBox1_Change()
ListBox1.Clear
If Sheets(1).Range("A1").Value = "" Then Sheets(1).Range("A1").Value = "C:\"
On Error GoTo hata
ChDir (Sheets(1).Range("A1").Value)
dosya = Application.GetOpenFilename(FileFilter:="Excel dosyaları,*.xls", Title:="Dosyayı seçiniz   evrengizlen@hotmail.com")
If dosya = False Then
    MsgBox "Bir seçim yapmadınız.İşlem iptal edildi", vbCritical, "UYARI"
    Exit Sub
End If
Sheets(1).Range("A1").Value = Left(dosya, Len(dosya) - Len(Dir(dosya)) - 1)
Set baglanti = CreateObject("ADODB.Connection")
baglanti.Open "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & dosya & _
";Extended Properties=""Excel 8.0;HDR=no;IMEX=1"";"
Set rs = baglanti.Execute("select*from [veri$b2:b65536] where F1 like '" & ComboBox1 & "%' order by F1")
If rs.BOF = False Then ListBox1.Column = rs.GetRows
rs.Close
baglanti.Close
Exit Sub
hata:
MsgBox "[ " & Sheets(1).Name & "!A1 Hücresinde yazılı olan yol = [ " & Sheets(1).Range("A1").Value & " ] sürücünüzde yoktur.", vbCritical, "YOL YOK"
End Sub

Private Sub CommandButton1_Click()
Set s1 = Sheets("Teklif Dosyası")
son = s1.[b65536].End(3).Row + 1
For a = 1 To 8
s1.Cells(son, a + 1) = Controls("textbox" & a)
Next
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub ListBox1_Click()
On Error Resume Next
For a = 1 To 8
Controls("textbox" & a) = ""
Next
yol = "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\Adres-Telefon Rehberi.xls;Extended Properties=""Excel 8.0;HDR=no;IMEX=1"";"
Set baglanti = CreateObject("ADODB.Connection")
baglanti.Open yol
Set rs = baglanti.Execute("select*from [veri$A2:P65536] where F2 like '" & ListBox1 & "%' order by F2")
TextBox1 = rs.fields(1)
TextBox2 = rs.fields(2)
TextBox3 = rs.fields(3)
TextBox4 = rs.fields(5)
TextBox5 = rs.fields(9)
TextBox6 = rs.fields(11)
TextBox7 = rs.fields(14)
TextBox8 = rs.fields(15)
rs.Close
baglanti.Close
End Sub

Bu kodlarla kapalı dosya bağlantısı yapılıyor ancak listboxtaki veriler textbox lara aktarılamıyor. Açık ve kapalı dosya aynı klasörde ise sorun yok. Kapalı dosyayı klasörden çıkarınca listboxtaki veriler textboxlara aktarılamıyor.
Hakkınızı helal edin.
 
Ne yapmak istediğinizi anlamış değilim.
Eğer listboxta listelenen bir veriyi tıklayarak textboxlara aktarmak istiyorsanız benim yazdığım kodlar doğrudur.Bunun için listboxa verilerin nerden geldiği önemli değildir.
İsterse veriler jupiterden gelsin hiç farketmez.:cool:
Bir dosya ekledim.İnceleyiniz.
 

Ekli dosyalar

Ama şimdi listboxa ado ile verileri aldığınız kodlara baktımda siz listboxa ado ile sadece veritabanından Bir kolon (B sütunu) almışsınız.Dolayısı ile 8 tane textboxa veri gitmez.Sadece bir textboxa veri gider.Çünkü listboxınızda bir sütunluk veri var.
Aşağıdaki ado ile listboxa veri alma kodunda kırmızı yeri değiştirerek 8 sütun veri alabilirsiniz.Dolayısı ile siz soruyu yanlış soruyorsunuz.Listboxa 8 sütun nasıl veri alabilirim diye sormalıydınız.Oysa siz listboxtan textboxa verileri nasıl alabilirim diyorsunuz.Dolayısı ile bizde onun cevabını verdiğimiz için sorununuz devam ediyor.:cool:

Kod: 
Set rs = baglanti.Execute("select*from [veri$[B][COLOR="Red"]b2:b65536[/COLOR][/B]] where F1 like '" & ComboBox1 & "%' order by F1")
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst