(VB6)Kodla Klasör-Data oluşturmada hata?

[Tankut SAZLI]

Arkadaşlar selam.

VİSUAL BASİC-6 da yaşadığım bir sorunumu paylaşmak istiyorum.Bu konuda yardıma ihtiyacım var.

Cat.Create sCnn

satırında -2147217897 hatası var diyor.Kodlardamı yanlışlık var bir türlü çözemedim.

Private Sub yenidata_kayit_Click()
On Error GoTo Klasorvar:
If Text1 = "" Then
MsgBox " Okul adını boş bırakamazsınız.", vbCritical, "DİKKAT!!!!!"
Exit Sub
Text1.SetFocus
End If
If Text2 = "" Then
MsgBox " Eğitim yılını boş bırakamazsınız.", vbCritical, "DİKKAT!!!!!"
Exit Sub
Text2.SetFocus
End If
Dim Cat     As Object
Dim Tbl(19) As Object
Dim sCnn    As String
Dim DatabasePath As String
Dim Şifre As String
Dim ds
Set ds = CreateObject("Scripting.FileSystemObject")
    Klasör = App.Path + "\Tools\DATA\" & Text1.Text

         
    ds.CreateFolder Klasör 'Yeni klasör oluşturuyoruz
olustur:
    Şifre = "" 'Veritabanını şifreliyoruz."xxxxx" x yazan yere şifrenizi yazın
    DatabasePath = App.Path + "\Tools\DATA\" & Text1.Text & "\" & Text2.Text & ".mdb" 'Oluşturlan klasör içine veritabanını atar ve Text2de yazanı isim olarak verir
    Set Cat = CreateObject("ADOX.Catalog")
    sCnn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DatabasePath & ";User ID=admin;Jet OLEDB:Database Password=" & Şifre 'Şifreli veritabanı yaratır
    Cat.Create sCnn


  '----------* Tablo Özelliklerinin Tanımlanması BRANŞLAR *----------
  Set Tbl(0) = CreateObject("ADOX.Table")
  Tbl(0).ParentCatalog = Cat
  With Tbl(0)
    .Name = "BRANŞLAR"
    .Columns.Append "BRANŞ_ADI", adVarWChar, 250
      .Columns("BRANŞ_ADI").Properties("Nullable").Value = False
  End With
  Cat.Tables.Append Tbl(0)

  '----------* Tablo Özelliklerinin Tanımlanması DERS_HAVUZU *----------
  Set Tbl(1) = CreateObject("ADOX.Table")
  Tbl(1).ParentCatalog = Cat
  With Tbl(1)
    .Name = "DERS_HAVUZU"
    .Columns.Append "DERS_KODU", adVarWChar, 50
      .Columns("DERS_KODU").Properties("Nullable").Value = False
    .Columns.Append "DERS_ADI", adVarWChar, 50
      .Columns("DERS_ADI").Properties("Description").Value = "1"
      .................................

     ...................................

     ...................................

  Set Cat = Nothing
  MsgBox Text1 & " Okuluna ait " & Text2 & " yılı bilgileri başarıyla oluşturulmuştur.", vbInformation, "RAPOR"
klasor_list.ListItems.Clear
egitimyil_list.ListItems.Clear
Text1.Text = ""
Text2.Text = ""
Call tusduzeni
Call KlasorListele
Call DosyaListele
Exit Sub
Exit Sub


Klasorvar:
If Err = 58 Then
If MsgBox(Text1 & " Okuluna ait " & Text2 & " yılı bilgilerini oluşturmak istediğinize eminmisiniz?", vbYesNo Or vbInformation, "ONAYLAMA") = vbYes Then
Text2.SetFocus
GoTo olustur
End If
End If

If Err = -2147217897 Then
If MsgBox(Text1 & " Okuluna ait " & Text2 & " yılı bilgileri zaten mevcut.Yeni yıl girişi yapmak istermisiniz?", vbYesNo Or vbCritical, "UYARI") = vbYes Then
Text2.Text = ""
Text2.SetFocus
Exit Sub
End If
End If
Exit Sub
End Sub

Yukarıdaki kodlarla bir access veri tabanı oluşturuyorum.Form üzerindeki 2 textboxtan biri oluşturacağım klasör adını ikincisi oluşturacağım data adını belirliyor.

Şimdi sorun şu;

1- Eğer daha önceden oluşturulmuş bir klasör varsa bu klasöre ait yeni data oluşturmak için 58 nolu hata mesajını göstermesi ve devam etmesi gerekiyor.burda pek sorun yok gibi aslında.yani yeni datayı oluşturuyor.

2-Önemli olan text2 ye yazdığımız isimle oluşturmak istediğimiz datanın o klasörün içerisinde varsa -2147217897 hata mesajına gitmesi ve görevi durdurması.İşte sorun burda başlıyor.Belirlediğim hata mesajını görmüyor.Yani 58 nolu her sefeeerinde 58 nolu hatayı gördükten sonra olustur: olayına dönüyor ve ordada data var olduğundan

Cat.Create sCnn

satırında hata veriyor.Bir türlü istediğim gibi ayarlayamadım.Yardımcı olursanız sevinirim.

Teşekkürler.

 

[alpi]

Önce
On Error GoTo Klasorvar:
hata kontrolünü prosedür başına koymanız hiçbir zaman doğru değil. Bu hata kontrolünü kontrol etmek istediğiniz satırın bir üstüne koyun. Bu şekilde başka bir hata meydana gelirse bunu anlayabilirsiniz.

Bunu yaptıktan sonra ki durum hakkında bilgilendirirseniz yardımcı olmaya çalışırım.

 

[Tankut SAZLI]

Sayın Alpi;
Dediğinizi yaptım.Bu kezde 3709 : Bağlantı,bu işlemi gerçekleştirmek için kullanılamıyor.Kapalı veya bu koşullarda geçersiz.
Diye yeni hata mesajından sonra

Tbl(0).ParentCatalog = Cat

satırına yöneldi.

 

[Levent Menteşoğlu]

Sn Tankut SAZLI

Konularımızdan biri VBA olduğundan, muhtemelen benzer konu olduğunu düşünerek VB ile ilgili bir soru sormuşsunuz. Bu konu ile ilgili sorularınızı VB forumlarına yöneltmeniz daha uygun olacaktır. Buraya sormakta ısrar ederseniz excel soruları dışında diğer başlıklara yazabilirsiniz.

 

[modalı]

Sayın Tankut SAZLI,

Access uygulamalarında kullandığım iki fonksiyon var. Bu fonksiyonlar araştıracağınız klasörü ve içini araştırıp oluşturmaya çalıştığınız dosyanın olup olmadığını arıyor ve eğer yoksa oluşturmasını sağlıyor. İki adet fonksiyon:

Function fReturnFilePath(strFileName As String, _
    strDrive As String) As String
Dim varItm As Variant
Dim strFiles As String
Dim strTmp As String
    
    If InStr(strFileName, ".") = 0 Then
        MsgBox "Sorry!! Need the complete name", vbCritical
        Exit Function
    End If
    
    strFiles = ""
    With Application.FileSearch
        .NewSearch
        .LookIn = strDrive
        .SearchSubFolders = True
        .Filename = strFileName
        .MatchTextExactly = True
        .FileType = msoFileTypeAllFiles
        If .Execute > 0 Then
            For Each varItm In .FoundFiles
                strTmp = fGetFileName(varItm)
                If strFileName = strTmp Then
                    fReturnFilePath = varItm
                    Exit Function
                End If
            Next varItm
        End If
    End With
End Function

Private Function fGetFileName(strFullPath) As String
Dim intPos As Integer, intLen As Integer
    intLen = Len(strFullPath)
    If intLen Then
        For intPos = intLen To 1 Step -1
            'Find the last \
            If Mid$(strFullPath, intPos, 1) = "\" Then
                fGetFileName = Mid$(strFullPath, intPos + 1)
                Exit Function
            End If
        Next intPos
    End If
End Function

Fonksiyona gidiş olarak şu parçayı yazdım

 Name1 = CurrentProject.Path & "\form118\" & tarih1 & ".xls"
    strFileName = tarih1 & ".xls"
    strFilePath = fReturnFilePath(strFileName, CurrentProject.Path)
    If strFilePath <> Name1 Then
         xlApp.Workbooks.Add(CurrentProject.Path & "\Form118.xlt").SaveAs Name1
    End If

Burada tarih1.xls Excel dosyası yoksa oluştur yoksa aç gibi bir komut veriyorum.

İşinize yarar sanırım.

İyi çalışmalar

 

[alpi]

Şu mesajı aldıktan sonra mı hata ile karşılaştınız

If MsgBox(Text1 & " Okuluna ait " & Text2 & " yılı bilgilerini oluşturmak istediğinize eminmisiniz?", vbYesNo Or vbInformation, "ONAYLAMA") = vbYes Then

Bunu şunun için soruyorum; GoTo olustur: satırı ile tekrar geri dönülmekte bu durumda set komutu kullanılan değişkenlerden dolayı hata meydana geliyor olabilir.

Size şöyle bir tavsiyede bulunmak isterim; Go to yerine tekrar işletilmesini istediğiniz satırlar için ayrı bir prosedür yazın. Daha açık bir ifade ile yukarıdaki prosedürünüzü birden fazla prosedür haline getirin. Örneğin bağlantı için ayrı bir prosedür, Kolonları oluşturmak ve adlandırmak için ayrı prosedür yazın. Prosedürlerinizi ne kadar artıtırsanız hem okuması kolay olur (böylelikle hatalar kolay anlaşılır) hemde daha verimli bir uygulama ortaya çıkımış olur.

 

[Tankut SAZLI]

Sayın leventm;
Ne deseniz haklısınız.Öncelikle benzer algoritmalar içerdiği için vb sorularını buraya taşşımakta sorun olmayacağını düşünmüştüm.Ve açıkça ifade etmeliyim ki diğer forumlarda burda gördüğüm performansı yakalayamıyorum.Bu nedenle konuyu burda açtım.Birde Excel dışındaki sorular için de bir başlık açabilseniz(var fakat sadece access) özellikle daha öncede belirttiğim gibi vba ile vb kardeş gibi olduklarından Visual Basic-6 başlığı herhalde daha geniş ve profesyonelce bir kitle yakalamanıza katkı sağlıcaktır diye naçizane görüşlerimi bildirmek isterim.
Lütfen saygısızlık olarak algılamayın,işinizi öğretme gibi bir düşüncem yoktu.
Teşekkürler.

 

[Tankut SAZLI]

Sayın alpi bir önceki mesajınızda dediğinz yöntemi uyguladıktan sonra sonra son mesajınızdaki hata ile karşılaşmadan belirttiğim hata çıktı.

 

[alpi]

Sayın Tankut Sazlı anlayamadım hatlar karıştı

Yeniden soruyormuş gibi sorar mısınız.

Birde kodlarınızın son halini de ekleyin.