+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Access (https://accesstr.net/forum-microsoft-access.html)
+--- Forum: Access Cevaplanmış Soruları (https://accesstr.net/forum-access-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Excel Dosyasında veri alma (/konu-excel-dosyasinda-veri-alma.html)
Excel Dosyasında veri alma - idrisy - 04/11/2016
Sayın hocalarım; EK teki Excel dosyasındaki verileri tabloya almak istiyorum ancak hata veriyor hatanın nedenini bulamadım.
Cvp: Excel Dosyasında veri alma - atoz112 - 04/11/2016
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.
Cvp: Excel Dosyasında veri alma - atoz112 - 04/11/2016
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.
Cvp: Excel Dosyasında veri alma - idrisy - 04/11/2016
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