DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Dosyayı güncelledim.Hocam pardon haklısınız kusura bakmayın. Sorum ekte dir.
Rica ederim.Sayın Evren Bey,
Yardımlarınız için çok teşekkür ederim.
Saygılarımla,
Dosyanız ektedir.
her 2 dosyada ayni klasörde olmalıdır.
Kod:Sub kapali_aktar() Dim conn As Object, rs As Object Set conn = CreateObject("AdoDb.Connection") Set rs = CreateObject("AdoDb.Recordset") conn.Open "Provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path & _ "\kapalı.xls;extended properties=""excel 8.0;hdr=yes""" rs.Open "Select * from [Kapalı$];", [COLOR="Red"]conn, 1, 3[/COLOR]sat = Cells(65536, "A").End(xlUp).Row + 1 rs.movefirst Range("A" & sat).CopyFromRecordset rs rs.Close conn.Close Set rs = Nothing Set conn = Nothing MsgBox "Kapalı dosyadan veriler aktarıldı." & vbLf & _ "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N" End Sub
keyset ve keylock tur. hdr = no yaparsanız vt 'de başlık olmayacağını söylerseniz..Bu durumda alan adı kullanamzsınız.Hocam Selamlar;
Alıntıda " conn, 1 , 3 " 'de ifade edilen 1 ve 3 'ün görevleri nedir? Bir Kod yazdım hdr=No olduğu halde başlıkları almakta problem yaşıyorum ve çözemedim. Başlıklarını aldığı sütunlarda alt değerleri alamıyorum, Başlıkları alamadığı sütunlarında alt değerleri tam olarak alınıyor. Buna bir yorum veya çözüm alabilirmiyim.
Teşekkürler.
sql sorgulama yapabilmeniz için alan adlarını(sütun başlıklarını) hdr=yes yapmalısınız.Aşağıdaki kodu deneyerek vt deki alan adlarını öğrenebilirsiniz.Hocam Veri Alınan dosyada alan tanımlaması yapmadığım içinmi böyle bir sorun yaşıyorum, çünkü Veri aldığım doysa server da read only olarak açıyorum.
sql sorgulama yapabilmeniz için alan adlarını(sütun başlıklarını) hdr=yes yapmalısınız.Aşağıdaki kodu deneyerek vt deki alan adlarını öğrenebilirsiniz.
for i = 0 to rs.fieldscount-1
msgbox rs(i).name
next
Veriler bu dosyaya aktarılacaksa kaynak dosyayıda yollamalısınız.Hocam ben bunu nasıl yapacağımı anlayamadım. İlgilenirseniz sıkıntı yaşadığım dosyayı ekte gönderdim. Emeğinize teşekkür ederim.
Veriler bu dosyaya aktarılacaksa kaynak dosyayıda yollamalısınız.![]()
Sub kapali_Dosyayi_aktar()
Dim fso As Object, fs As Object, hcr As Range, z, deg As String
Set fso = CreateObject("Scripting.FileSystemObject")
'On Error Resume Next
For Each fs In fso.getfolder(ThisWorkbook.Path).Files
z = Split(fs.Name, " - ")
If z(0) = ActiveSheet.Name Then
Range("A1").Value = Application.ExecuteExcel4Macro("'" & _
ThisWorkbook.Path & "\[" & fs.Name & "]Sheet1'!R1C1")
For Each hcr In Range("A4:AD28")
hcr.Value = Application.ExecuteExcel4Macro("'" & _
ThisWorkbook.Path & "\[" & fs.Name & "]Sheet1'!R" & hcr.Row & "C" & hcr.Column)
Next
End If
Next
MsgBox "İşlem tamamdır." & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
bir önceki mesajda(35nci mesaj) yoladığım dostayadaki ana dosyayı bu yolladıklarınız içinde kullanabilirisiniz.Hocam Selamlar;
Hazırlamış olduğunuz kod dosyasını aldım, kodları inceliyorum kendi yollarımı ve dosya isimlerini yazarak revize edeceğim. Çalışmanız için çok teşekkür ederim.
Hocam bu konuyla ilgili farklı bir çalışma yaptım dosyaları ekte gönderiyorum, inceleyebilirmisiniz. Veri transferini hızlandırabilirmiyiz? Eksiklerimle ilgili önerilerinizin benim için büyük önem taşıdığını bilmenizi isterim. Yaptığım çalışmada sizin yazılarınızda göndermiş olduğunuz kodlardan yararlandım. Konularınızı ve konulara cevaplarınızı takip etmeye devam edeceğim. İyi çalışmalar diliyorum.