AccessTr.neT

tarih geliyordu denemelerimde? sadece 01 yerine 1 geliyordu?

(04/11/2020, 17:06)berduş yazdı: [ -> ]tarih geliyordu denemelerimde? sadece 01 yerine 1 geliyordu?

kodu kopyala yapıştırdım sadece tarih gelmedi

tarih alanı verileri hangi sütundan alıyor?
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?
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

veri S sutunu ile G sutunu Form B sutununuda birleşeçek

tmm 19. ve 7. sütun aşağıdaki dosyayı inceler misiniz?

https://resim.accesstr.net/do.php?img=10581