tarih geliyordu denemelerimde? sadece 01 yerine 1 geliyordu?
Veri Aktarma
tarih alanı verileri hangi sütundan alıyor?
bu arada aşağıdaki kodu dener misiniz?
bu arada aşağıdaki kodu dener misiniz?
Sub Aktar()
Dim syfForum As Worksheet
Dim i As Long, son As Long, sonVer As Long
Set syfForum = ThisWorkbook.Sheets("Form")
With ThisWorkbook.Sheets("Veri")
syfForum.Range("A2:F" & Rows.Count).ClearContents
Application.ScreenUpdating = False
Dim Sql As String
Dim ADO_CN As Object
Dim ADO_RS As Object
Set ADO_CN = CreateObject("Adodb.Connection")
Set ADO_RS = CreateObject("adodb.recordset")
SQL = "SELECT F6, format(cdate(F19),'dd.mm.yyyy') & ' ' & F7, F2 & '-' & F3, F12, F4 "
SQL = Sql & vbCrLf
SQL = Sql & "FROM [Veri$" & "] where F13='Yabancı Araç Plakasına' ;"
ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & _
";extended properties=""excel 8.0;hdr=no;imex=1"""
ADO_CN.Open
ADO_RS.Open SQL, ADO_CN, 3, 1
'
' Eğer Hiç Kayıt Yoksa
If ADO_RS.RecordCount = 0 Then
ADO_RS.Close
ADO_CN.Close
Set ADO_RS = Nothing
Set ADO_CN = Nothing
MsgBox "Kayıt Bulunamadı.", vbCritical, "Veri Yok"
Exit Sub
End If
ADO_RS.movelast
ADO_RS.movefirst
Debug.Print ADO_RS.RecordCount
syfForum.Range("a2").CopyFromRecordset ADO_RS
ADO_RS.Close
ADO_CN.Close
Set ADO_RS = Nothing
Set ADO_CN = Nothing
'
MsgBox "Akrarma Tamam...", vbInformation, "Aktarma"
Application.ScreenUpdating = True
End With
GoTo son2
son:
MsgBox "Akrarma Basarisiz...", vbExclamation, "Aktarma"
son2:
Set syfForum = Nothing
End Sub
S sütunu ile G sütunu birleşecek
(04/11/2020, 17:21)berduş yazdı: tarih alanı verileri hangi sütundan alıyor?veri S sutunu ile G sutunu Form B sutununuda birleşeçek
bu arada aşağıdaki kodu dener misiniz?
Sub Aktar()
Dim syfForum As Worksheet
Dim i As Long, son As Long, sonVer As Long
Set syfForum = ThisWorkbook.Sheets("Form")
With ThisWorkbook.Sheets("Veri")
syfForum.Range("A2:F" & Rows.Count).ClearContents
Application.ScreenUpdating = False
Dim Sql As String
Dim ADO_CN As Object
Dim ADO_RS As Object
Set ADO_CN = CreateObject("Adodb.Connection")
Set ADO_RS = CreateObject("adodb.recordset")
SQL = "SELECT F6, format(cdate(F19),'dd.mm.yyyy') & ' ' & F7, F2 & '-' & F3, F12, F4 "
SQL = Sql & vbCrLf
SQL = Sql & "FROM [Veri$" & "] where F13='Yabancı Araç Plakasına' ;"
ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & _
";extended properties=""excel 8.0;hdr=no;imex=1"""
ADO_CN.Open
ADO_RS.Open SQL, ADO_CN, 3, 1
'
' Eğer Hiç Kayıt Yoksa
If ADO_RS.RecordCount = 0 Then
ADO_RS.Close
ADO_CN.Close
Set ADO_RS = Nothing
Set ADO_CN = Nothing
MsgBox "Kayıt Bulunamadı.", vbCritical, "Veri Yok"
Exit Sub
End If
ADO_RS.movelast
ADO_RS.movefirst
Debug.Print ADO_RS.RecordCount
syfForum.Range("a2").CopyFromRecordset ADO_RS
ADO_RS.Close
ADO_CN.Close
Set ADO_RS = Nothing
Set ADO_CN = Nothing
'
MsgBox "Akrarma Tamam...", vbInformation, "Aktarma"
Application.ScreenUpdating = True
End With
GoTo son2
son:
MsgBox "Akrarma Basarisiz...", vbExclamation, "Aktarma"
son2:
Set syfForum = Nothing
End Sub
Son Düzenleme: 04/11/2020, 17:24, Düzenleyen: HORZUM.
tmm 19. ve 7. sütun aşağıdaki dosyayı inceler misiniz?
Yabancı_hy.rar
(Dosya Boyutu: 21,29 KB | İndirme Sayısı: 5)
Konuyu Okuyanlar: 1 Ziyaretçi
