Tek Sütunlu Sorgu Oluşturma

1 2 3
21/10/2020, 19:23

truhi

(21/10/2020, 18:58)ozanakkaya yazdı:
Dim rst As New ADODB.Recordset
Dim i, GSayi1, GSayi2 As Integer
Dim GAlan, GTabloAdi As String

rst.Open "SELECT * FROM Table1", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly

GTabloAdi = "YeniTablo"

GSayi1 = Val(Left([Metin1], InStr(1, [Metin1], "-") - 1)) - 1
GSayi2 = Val(Mid([Metin1], InStr(1, [Metin1], "-") + 1)) - 1



For i = GSayi1 To GSayi2
    GAlan = GAlan & "," & rst.Fields(i).Name
Next i

    GAlan = Right(GAlan, Len(GAlan) - 1)



DoCmd.RunSQL "SELECT " & GAlan & " INTO " & GTabloAdi & " FROM Table1;"


End Sub


Metin kutusuna 1-2 şeklinde tire koyarak yazmalısın.
ilginize teşekkürler, yalnız burada aralıktaki tüm alanları aktarıyor.
Benim istediğim ise sadece yazılan alanların aktarılması, 3-7 yazarsam; 3. ve 7. alanı (sadece 2 alan) aktarsın. aradaki alanları atlasın.

iyi akşamlar.
21/10/2020, 19:51

ozanakkaya

Dim rst As New ADODB.Recordset
Dim GSayi1, GSayi2 As Integer
Dim GAlan, GTabloAdi As String

rst.Open "SELECT * FROM KISILER", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly

GTabloAdi = "YeniTablo"

If InStr(1, Me.Metin1, "-") = 0 Then

GAlan = rst.Fields(Metin1 - 1).Name

Else

GSayi1 = Val(Left([Metin1], InStr(1, [Metin1], "-") - 1)) - 1
GSayi2 = Val(Mid([Metin1], InStr(1, [Metin1], "-") + 1)) - 1
GAlan = rst.Fields(GSayi1).Name & "," & rst.Fields(GSayi2).Name

End If

DoCmd.RunSQL "SELECT " & GAlan & " INTO " & GTabloAdi & " FROM KISILER;"
22/10/2020, 09:47

truhi

(21/10/2020, 19:51)ozanakkaya yazdı:
Dim rst As New ADODB.Recordset
Dim GSayi1, GSayi2 As Integer
Dim GAlan, GTabloAdi As String

rst.Open "SELECT * FROM KISILER", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly

GTabloAdi = "YeniTablo"

If InStr(1, Me.Metin1, "-") = 0 Then

    GAlan = rst.Fields(Metin1 - 1).Name

Else

    GSayi1 = Val(Left([Metin1], InStr(1, [Metin1], "-") - 1)) - 1
    GSayi2 = Val(Mid([Metin1], InStr(1, [Metin1], "-") + 1)) - 1
    GAlan = rst.Fields(GSayi1).Name & "," & rst.Fields(GSayi2).Name

End If

DoCmd.RunSQL "SELECT " & GAlan & " INTO " & GTabloAdi & " FROM KISILER;"

çok teşekkürler...
22/10/2020, 17:31

truhi

(21/10/2020, 19:51)ozanakkaya yazdı:
Dim rst As New ADODB.Recordset
Dim GSayi1, GSayi2 As Integer
Dim GAlan, GTabloAdi As String

rst.Open "SELECT * FROM KISILER", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly

GTabloAdi = "YeniTablo"

If InStr(1, Me.Metin1, "-") = 0 Then

    GAlan = rst.Fields(Metin1 - 1).Name

Else

    GSayi1 = Val(Left([Metin1], InStr(1, [Metin1], "-") - 1)) - 1
    GSayi2 = Val(Mid([Metin1], InStr(1, [Metin1], "-") + 1)) - 1
    GAlan = rst.Fields(GSayi1).Name & "," & rst.Fields(GSayi2).Name

End If

DoCmd.RunSQL "SELECT " & GAlan & " INTO " & GTabloAdi & " FROM KISILER;"

merhaba,
Kodu çalıştırdığımıza ekrana gelen ekli mesaj kutularını nasıl iptal edebiliriz?
Bize sormadan direkt işlemleri yapsın.

şimdiden teşekkürler,
iyi çalışmalar.
22/10/2020, 19:19

ozanakkaya

Docmd.runsql Kodunun üstüne

docmd.setWarnings false

Üstüne de 

docmd. SetWarnings true

Kodu ekle
22/10/2020, 19:20

feraz

DoCmd.RunSQL
Yukarıdakinisilip alttakiniekleyin.
CurrentDb.Execute
1 2 3