DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Yapmak istediğinizi örnekleyiniz.
Sub veri_aktar()
a = MsgBox(" Bu kayıtı yapmak istiyormusunuz. ", vbYesNo + vbInformation, " Rapor aktarımı")
If a = vbNo Then
Exit Sub
End If
[COLOR="Red"]Dosya = "C:\Documents and Settings\Administrator\Desktop\bbb\deneme.mdb"
Sayfa_adı = "Profiller"
Tablo_adi = "Alan1"
Uzanti = "mdb"[/COLOR]
Dim Kayit As ADODB.Recordset
Set Kayit = CreateObject("adodb.recordset")
'sifre = "1234"
If Uzanti = "xls" Then
baglan = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Dosya & ";Extended Properties=""Excel 8.0;HDR=yes""" 'ofis 2003
Kayit.Open "SELECT " & Tablo_adi & " FROM [" & Sayfa_adı & "$] ", baglan, adOpenKeyset, adLockOptimistic
ElseIf Uzanti = "xlsb" Or Uzanti = "xlsx" Or Uzanti = "xlsm" Then
baglan = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & Dosya & ";Extended Properties=""Excel 12.0;HDR=yes""" 'ofis 2007
Kayit.Open "SELECT " & Tablo_adi & " FROM [" & Sayfa_adı & "$] ", baglan, adOpenKeyset, adLockOptimistic
ElseIf Uzanti = "mdb" Then
baglan = "provider=microsoft.jet.oledb.4.0;data source=" & Dosya ' & ";User ID=admin;Jet OLEDB:Database Password=" & sifre
Kayit.Open "select * from " & Sayfa_adı, baglan, 3, 2
ElseIf Uzanti = "accdb" Then
baglan = "Provider=Microsoft.ACE.OLEDB.12.0;data source=" & Dosya ' & ";User ID=admin;Jet OLEDB:Database Password=" & sifre
Kayit.Open "select * from " & Sayfa_adı, baglan, 3, 2
Else
Exit Sub
End If
For i = 2 To Cells(Rows.Count, "h").End(3).Row
Kayit.AddNew
Kayit([COLOR="red"]"Alan1"[/COLOR]) = Cells(i, "h").Value
Next i
Kayit.Update
Kayit.Close
MsgBox "kayıt işlemi tamamdır"
Set Kayit = Nothing
End Sub
Şimdi sorduğunuz soru ile gönderdiğiniz dosya çok çok farklıhalit3
Haklısınız hocam. bundan sonraki sorularımda örnek dosya eklemeye çalışacağım..
verdiğiniz kodları ekledim ve düzenledim.. fakat bir hata iletisi alıyorum.. hata iletisini ve ornek dosyaları bir link e ekledim.
http://s3.dosya.tc/server21/RxuJAU/ornek.rar.html
Private Sub CommandButton1_Click()
a = MsgBox(" Bu kayıtı yapmak istiyormusunuz. ", vbYesNo + vbInformation, " Rapor aktarımı")
If a = vbNo Then
Exit Sub
End If
[COLOR="Red"]Dosya = "C:\Documents and Settings\Administrator\Desktop\Ebatlar.mdb"
Sayfa_adı = "profiller"
Tablo_adi = "prfID, prfname, h, b, s, t, r1, r2, fs, metrekg"
Uzanti = "mdb"
[/COLOR]
Dim Kayit As ADODB.Recordset
Set Kayit = CreateObject("adodb.recordset")
'sifre = "1234"
If Uzanti = "xls" Then
baglan = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Dosya & ";Extended Properties=""Excel 8.0;HDR=yes""" 'ofis 2003
Kayit.Open "SELECT " & Tablo_adi & " FROM [" & Sayfa_adı & "$] ", baglan, adOpenKeyset, adLockOptimistic
ElseIf Uzanti = "xlsb" Or Uzanti = "xlsx" Or Uzanti = "xlsm" Then
baglan = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & Dosya & ";Extended Properties=""Excel 12.0;HDR=yes""" 'ofis 2007
Kayit.Open "SELECT " & Tablo_adi & " FROM [" & Sayfa_adı & "$] ", baglan, adOpenKeyset, adLockOptimistic
ElseIf Uzanti = "mdb" Then
baglan = "provider=microsoft.jet.oledb.4.0;data source=" & Dosya ' & ";User ID=admin;Jet OLEDB:Database Password=" & sifre
Kayit.Open "select * from " & Sayfa_adı, baglan, 3, 2
ElseIf Uzanti = "accdb" Then
baglan = "Provider=Microsoft.ACE.OLEDB.12.0;data source=" & Dosya ' & ";User ID=admin;Jet OLEDB:Database Password=" & sifre
Kayit.Open "select * from " & Sayfa_adı, baglan, 3, 2
Else
Exit Sub
End If
For j = 2 To Cells(Rows.Count, "h").End(3).Row
Kayit.AddNew
Kayit(0) = Kayit.RecordCount + 1
For i = 1 To Kayit.Fields.Count - 1
If i = 1 Then
Kayit(i) = Cells(j, "h").Value
Else
Kayit(i) = ""
End If
Next i
Next j
Kayit.Update
Kayit.Close
MsgBox "kayıt işlemi tamamdır"
Set Kayit = Nothing
End Sub
Bendeki referenslar böylehalit3
Hocam; örnek2.rar dosyasını başka bir linke eklemeniz mümkü mü ? yeni kodlarıda ekledim yine aynı durum. bir de referans kontroller bunları nasıl ayarlamalıyım..? <-- Sanırım problem bu kısımdan kaynaklanıyor..
Visual Basic For Applications
Microsoft Excel 12.0 Object Library
OLE Automation
Microsoft Office 12.0 Object Library
Microsoft Forms 2.0 Object Library
Microsoft ActiveX Data Objects 2.0 Library
Microsoft ADO Ext. 2.8 for DDL and Security
Microsoft DAO 3.6 Object Library
Kayit.Open "select * from " & sayfa_adı, baglan, 3, 2
Private Sub CommandButton1_Click()
a = MsgBox(" Bu kayıtı yapmak istiyormusunuz. ", vbYesNo + vbInformation, " Rapor aktarımı")
If a = vbNo Then
Exit Sub
End If
Dosya = "C:\Documents and Settings\Administrator\Desktop\Ebatlar.mdb"
Sayfa_adı = "profiller"
Uzanti = "mdb"
Dim Kayit As ADODB.Recordset
Set Kayit = CreateObject("adodb.recordset")
If Uzanti = "xls" Then
baglan = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Dosya & ";Extended Properties=""Excel 8.0;HDR=yes""" 'ofis 2003
Kayit.Open "SELECT * FROM [" & Sayfa_adı & "$] ", baglan, adOpenKeyset, adLockOptimistic
ElseIf Uzanti = "xlsb" Or Uzanti = "xlsx" Or Uzanti = "xlsm" Then
baglan = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & Dosya & ";Extended Properties=""Excel 12.0;HDR=yes""" 'ofis 2007
Kayit.Open "SELECT * FROM [" & Sayfa_adı & "$] ", baglan, adOpenKeyset, adLockOptimistic
ElseIf Uzanti = "mdb" Then
baglan = "provider=microsoft.jet.oledb.4.0;data source=" & Dosya ' & ";User ID=admin;Jet OLEDB:Database Password=" & sifre
Kayit.Open "select * from " & Sayfa_adı, baglan, 3, 2
ElseIf Uzanti = "accdb" Then
baglan = "Provider=Microsoft.ACE.OLEDB.12.0;data source=" & Dosya ' & ";User ID=admin;Jet OLEDB:Database Password=" & sifre
Kayit.Open "select * from " & Sayfa_adı, baglan, 3, 2
Else
Exit Sub
End If
For j = 1 To Cells(Rows.Count, "h").End(3).Row
Kayit.AddNew
Kayit(0) = Kayit.RecordCount + 1
For i = 1 To Kayit.Fields.Count - 1
If i = 1 Then
Kayit(i) = Cells(j, "h").Value
Else
Kayit(i) = ""
End If
Next i
Next j
Kayit.Update
Kayit.Close
MsgBox "kayıt işlemi tamamdır"
Set Kayit = Nothing
End Sub
Ben sizin 1 nolu mesajınıza cevap verdim Access veri taban ile aram iyi değil benden bu kadar.halit3
Hocam video için çok teşekkür ederim. küçük bir ekleme yapma şansımız var mıdır. ? şimdi exceldeki kayıtları prfname alanına kayıt ediyoruz.. bu tamam.
Kodlarda ; Prfname yi bir değişkene bağlayabilirmiyiz..?
Mesela : Alansecimi=prfname gibi.. ben burdan gerektiğinde Alansecimi değişkenini ayalayabileyim.. kodları inceledim ama prfname yi değiştirecek kısmı
bulamadım..
örnekleme :
Alansecimi=Prfname
Alansecimi=b
Alansecimi=h
bunlardan biri gibi...
Not: kodlarda her zaman sadece bir Alan secimi ayarlanmış olmalı.