[VBA] Excelden veri alırken seç,len dosyanın açılması sorunu
#1
Sayın hocalarım; aşağıdaki kod ile excelden veri alıyorum. Veri alamada sorun yok ancak her defasında excel dosyasını açıyor. Excel dosyasının açılmasını nasıl önleyebilirim acaba?

Private Sub EXCELDENAL_Click()
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Dim dosya 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

dosya = varFile
Dim sonsatirno As Integer
Dim crt As Long
Dim kacadet, strSinifAdi, strtoplam As Integer
Dim strkriter, strokulturu, strSubeAdi As String

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(dosya)
Set xlSheet = xlBook.Worksheets(1)

'Dim myRec As DAO.Recordset
sonsatirno = xlSheet.Range("A65536").End(xlUp).Row
Debug.Print sonsatirno
'Set myRec = CurrentDb.OpenRecordset("Tbl_Gider")

For I = 8 To sonsatirno
If xlSheet.Cells(I, "D") >= 0 Then
'MsgBox crt & " " & " bu gider değil"
Else

strSQL = "SELECT * FROM Tbl_Gider "
Set rstkayit = New ADODB.Recordset
rstkayit.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
With rstkayit
kriterim = xlSheet.Cells(I, "B") & "-" & xlSheet.Cells(I, "A")
.Find "[kriter]=" & "'" & kriterim & "'"
If Not rstkayit.EOF Then

.Fields("Tarih") = xlSheet.Cells(I, "A")
.Fields("FisNo") = xlSheet.Cells(I, "B")
.Fields("GiderAciklamasi") = xlSheet.Cells(I, "C")
.Fields("Tutar") = Mid((xlSheet.Cells(I, "D")), 2, ((Len(xlSheet.Cells(I, "D")) - 1)))
.Fields("ay") = Format$(xlSheet.Cells(I, "A"), "mmmm")
.Fields("Yil") = Format$(xlSheet.Cells(I, "A"), "yyyy")
'.Fields("kriter") = xlSheet.Cells(I, "B") & "-" & xlSheet.Cells(I, "A")

kacadet = kacadet + 1
lbxData.Requery
.Update
Else
.AddNew
.Fields("Tarih") = xlSheet.Cells(I, "A")
.Fields("FisNo") = xlSheet.Cells(I, "B")
.Fields("GiderAciklamasi") = xlSheet.Cells(I, "C")
.Fields("Tutar") = Mid((xlSheet.Cells(I, "D")), 2, ((Len(xlSheet.Cells(I, "D")) - 1)))
.Fields("ay") = Format$(xlSheet.Cells(I, "A"), "mmmm")
.Fields("Yil") = Format$(xlSheet.Cells(I, "A"), "yyyy")
.Fields("kriter") = xlSheet.Cells(I, "B") & "-" & xlSheet.Cells(I, "A")

kacadet = kacadet + 1
lbxData.Requery
.Update
End If
End With
End If

Next
xlApp.Visible = True
xlBook.Close
xlApp.Quit

Set xlApp = Nothing
Set xlBook = Nothing
lbxData.Requery
If kacadet > 0 Then MsgBox kacadet & " " & "Yeni Kayıt Eklendi"



Next
Else
MsgBox "Vazgeçildi."
End If
End With
EXCELDENAL_Exit:
Exit Sub
EXCELDENAL_Err:
MsgBox Error$
Resume EXCELDENAL_Exit
End Sub[/code]



  Alıntı
Bu mesajı beğenenler:
#2
xlApp.Visible = True yerine False olarak dener misiniz ?



  Alıntı
Bu mesajı beğenenler:
#3
Hocam; teşekkür ederim



  Alıntı
Bu mesajı beğenenler:


Benzer Konular...
Konu: Yazar Cevaplar: Gösterim: Son Mesaj
access-sql-20 [TABLO] Liste Kutusu-çoklu Seçim özellikli Alana Excelden Verileri Yapıştırma mkoblayek 18 1.057 18-02-2025, 08:49
Son Mesaj: mkoblayek
  Excellden Tabloya Veri Aktarım Sorunu kral8596 1 444 23-05-2024, 11:52
Son Mesaj: dsezgin
access-sql-18 Dsum Ile Toplam Alırken Tarih Aralığınıda Süzme Yaptırma Sorunu kesoka 2 540 07-04-2024, 16:13
Son Mesaj: kesoka
access-sql-18 Sorgu Kapatınca Formun Açılması burhanb 1 316 18-11-2023, 00:44
Son Mesaj: dsezgin
  Access'e Excelden Dış Veri Almak snapper 3 501 02-10-2023, 22:55
Son Mesaj: dsezgin
  [FORM] Gizlenen Access'in Açılması Fatih Sipahi 6 1.448 09-08-2023, 10:43
Son Mesaj: mustafa.sogutlu
  Raporda Veri Görüntüleme Sorunu EminA 2 423 21-10-2022, 20:57
Son Mesaj: EminA
  Excelden Kopyaladığım Verilerin Tabloya Eksik Eklenmesi alikagan 3 472 06-04-2022, 13:03
Son Mesaj: dsezgin

Foruma Git:


Bu konuyu görüntüleyen kullanıcı(lar): 1 Ziyaretçi