AccessTr.neT

Sayın hocalarım; EK teki Excel dosyasındaki verileri tabloya almak istiyorum ancak hata veriyor hatanın nedenini bulamadım.

sayın idrisy,

bahsettiğiniz talebinize yönelik olarak;

aldığınızı beyan ettiğiniz hata nedir,ayrıntılı açıklamasını ve olduğu esnadaki halini içeren ekran görüntüsünü de dahil  ediniz.

bilginize...iyi çalışmalar,saygılar.

sayın idrisy,

uygulamanızı kısa süreli bir inceleme neticesinde,
naçizane bir tavsiye olması adına,kaldı ki uygulamanızın sorunlarını gidermeniz için bir bakıma faydalı da olacağı düşüncesi ile;

kod sayfasına ALT + F11 tuşu ile geçiniz ve üst menüden DEBUG - COMPILE seçeneği ile mevcut hataları ya da sorunları uygun yazımlar neticesinde düzeltmeye gayret ediniz.

örneğin;LEFT Fonksiyonu yazım hataları gibi.aşağıdaki bağlantıyı inceleyiniz.

LEFT Fonksiyonu kullanımı

son olarak;
tablolarınızdaki ı harflerini i olarak değiştirerek kullanmayı unutmayınız.

Konulara eklenen Uygulama içeriğine yönelik Tavsiyeler

yukarıda bağlantısı yazılı konuyu incelemenizi ve içeriğindeki  hususlara göre bu ve bundan sonraki uygulamalarını düzenlemeye gayret ediniz.

bilginize...iyi çalışmalar,saygılar.

Hocam; ilginiz için teşekkür ederim. Kodda Left hatası veriyordu. Sizin uyarınızdan sonra dikkatle incelerken virgülü yanlış yere koyduğumu fark ettim.

Kodun doğrusu aşağıdaki şekilde, kullanmak isteyen arkadaşlar için;

Private Sub EXCELDENAL_Click()

 Dim fDialog As Office.FileDialog

   Dim varFile As Variant

   Dim hakan As String

On Error GoTo EXCELDENAL_Err

  

   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)



   With fDialog

   

      .AllowMultiSelect = False

      

      .title = "Lütfen Aktaracağınız Bilgilerin Bulunduğu Excel Dosyasını Seçin"

      

      

      .Filters.Clear

      .Filters.Add "Excel 2003", "*.xls"

      .Filters.Add "Excel 2007", "*.xlsx"

      .Filters.Add "All Files", "*.*"

      

      If .show = True Then

      

         For Each varFile In .SelectedItems

         

     hakan = varFile

    Dim sonsatirno As Integer

    Dim crt As Long

    Dim kacadet As Integer

    Dim strkriter As String

    Dim xlApp As Excel.Application

    Dim xlBook As Excel.Workbook

    

    Set xlApp = CreateObject("Excel.Application")

    Set xlBook = xlApp.Workbooks.Open(hakan)

    Set xlSheet = xlBook.Worksheets(1)

    

    Dim myRec As DAO.Recordset

    sonsatirno = xlSheet.Range("A200").End(xlUp).row

    Debug.Print sonsatirno

    Set myRec = CurrentDb.OpenRecordset("TabloSınıf")



                For I = 2 To sonsatirno

               ' crt = xlSheet.Cells(I, "B")

                 If Len(xlSheet.Cells(I, "A")) = 0 Then

                ' MsgBox crt & " " & " alanı mükerrer kayıt olduğundan kaydedilmedi"

                

                Else

                myRec.AddNew

                myRec.Fields("SinifAdi") = Left(Trim(Mid(xlSheet.Cells(I, "A"), InStr(1, xlSheet.Cells(I, "A"), "-") + 2)), InStr(1, Trim(Mid(xlSheet.Cells(I, "A"), InStr(1, xlSheet.Cells(I, "A"), "-") + 2)), ".") - 1)

                myRec.Fields("SubeAdi") = Left(Trim(Mid(xlSheet.Cells(I, "A"), InStr(1, xlSheet.Cells(I, "A"), "/") + 1)), 1)

           strkriter = Left(xlSheet.Cells(I, "A"), InStr(xlSheet.Cells(I, "A"), "-"))

                myRec.Fields("turadi") = Left(strkriter, InStr(strkriter, "-") - 2) 'DLookup("OkulID", "TabloOkulTuru", "[Kısaltma] =" & Left(xlSheet.Cells(I, "A"), InStr(xlSheet.Cells(I, "A"), "-") - 1 & ""))

                myRec.Fields("OkulTuru") = Dlookup ("OkulID", "TabloOkulTuru", "[Kısaltma] ='" & Left(strkriter, InStr(strkriter, "-") - 2) & "'")

                myRec.Fields("ErkekOgrenci") = xlSheet.Cells(I, "K")

                myRec.Fields("AktifOgretimYili") = Metin2

              

                

                myRec.Update

                kacadet = kacadet + 1

                End If

                Next

                xlApp.Visible = True

                xlBook.Close

                xlApp.Quit

                

                Set xlApp = Nothing

                Set xlBook = Nothing

                

                If kacadet > 0 Then MsgBox kacadet & " " & "Yeni Kayıt Eklendi"

                

                Me.Liste34.Requery

                

         Next

      Else

         MsgBox "Vazgeçildi."

      End If

   End With

EXCELDENAL_Exit:

    Exit Sub



EXCELDENAL_Err:

    MsgBox Error$

    Resume EXCELDENAL_Exit



End Sub