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